[multiple changes]

2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat_ugn.texi: Document -Wstack-usage.
	* gcc-interface/misc.c (enumerate_modes): Add guard for ghost FP modes.

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

	* sem_prag.adb Issue an error (not a warning) when a C++ type does not
	have keyword LIMITED.

2011-08-03  Yannick Moy  <moy@adacore.com>

	* alfa.adb, alfa.ads, alfa_test.adb: New files.
	* ali.adb (Known_ALI_Lines): add 'C' lines (SCO) and 'F' lines (ALFA)
	(Scan_ALI): do not issue a fatal error if parsing known lines after Xref
	section (does not happen in compiler, only if code directly calls
	Scan_ALI).
	* get_alfa.adb, get_alfa.ads: New files.
	* lib-writ.adb, lib-writ.ads (Write_ALI): output ALFA information if
	needed.
	* lib-xref-alfa.adb: New file.
	* lib-xref.adb, lib-xref.ads
	(Xref_Entry): redefine information needed in cross-references for ALFA.
	Push ALFA treatments in separated local package.
	(Enclosing_Subpragram_Or_Package): treat specially subprogram
	identifiers. Return entity of package body instead of spec. Return
	Empty for a scope with no location.
	(Generate_Reference): adapt to new components for ALFA information.
	Remove the need for D references on definitions.
	(Is_Local_Reference): moved to ALFA local package
	(Output_References): extract subfunction as Extract_Source_Name
	(Output_Local_References): remove procedure, replaced by filtering of
	cross-references in package ALFA and printing in Put_ALFA.
	(Write_Entity_Name): remove procedure
	* lib.adb, lib.ads (Extract_Source_Name): extract here function to
	print exact name of entity as it appears in source file
	(Unit_Ref_Table): make type public for use in Lib.Xref.ALFA
	* put_alfa.adb, put_alfa.ads: New files.
	* xref_lib.adb (Search_Xref): protect read of cross-references against
	reading other sections of the ALI file, in gnatxref
	(Search): protect read of cross-references against reading other
	sections of the ALI file, in gnatfind.
	* gcc-interface/Make-lang.in: Update dependencies.

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

	* sem_ch3.adb: Minor reformatting.

2011-08-03  Jose Ruiz  <ruiz@adacore.com>

	* s-inmaop-vxworks.adb (Setup_Interrupt_Mask): Do nothing instead of
	raising an exception.

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

	* sem_res.adb (Set_String_Literal_Subtype): if index type is an integer
	type, always use 1 as the lower bound or string, even if lower bound of
	context is not static, to handle properly null strings in a non-static
	context.

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

	* sem_prag.adb (Resolve_Aggregate): An array aggregate with 'others' is
	always legal on the right-hand side of an assignment statement; there
	is always an applicable index constraint in this case. Therefore, the
	check for Pkind = N_Assignment_Statement is now unconditional -- it
	doesn't depend on whether Is_Constrained (Typ).

From-SVN: r177239

1 files changed, 460 insertions, 0 deletions

diff --git a/gcc/ada/get_alfa.adb b/gcc/ada/get_alfa.adb
new file mode 100644
index 0000000..95a0f94
--- /dev/null
+++ b/gcc/ada/get_alfa.adb
@@ -0,0 +1,460 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             G E T _ A L F A                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with ALFA;  use ALFA;
+with Types; use Types;
+
+with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+
+procedure Get_ALFA is
+   C    : Character;
+
+   use ASCII;
+   --  For CR/LF
+
+   Cur_File : Nat;
+   --  Dependency number for the current file
+
+   Cur_Scope : Nat;
+   --  Scope number for the current scope entity
+
+   Cur_File_Idx : File_Index;
+   --  Index in ALFA_File_Table of the current file
+
+   Cur_Scope_Idx : Scope_Index;
+   --  Index in ALFA_Scope_Table of the current scope
+
+   Name_Str : String (1 .. 32768);
+   Name_Len : Natural := 0;
+   --  Local string used to store name of File/entity scanned as
+   --  Name_Str (1 .. Name_Len).
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function At_EOL return Boolean;
+   --  Skips any spaces, then checks if we are the end of a line. If so,
+   --  returns True (but does not skip over the EOL sequence). If not,
+   --  then returns False.
+
+   procedure Check (C : Character);
+   --  Checks that file is positioned at given character, and if so skips past
+   --  it, If not, raises Data_Error.
+
+   function Get_Nat return Nat;
+   --  On entry the file is positioned to a digit. On return, the file is
+   --  positioned past the last digit, and the returned result is the decimal
+   --  value read. Data_Error is raised for overflow (value greater than
+   --  Int'Last), or if the initial character is not a digit.
+
+   procedure Get_Name;
+   --  On entry the file is positioned to a name. On return, the file is
+   --  positioned past the last character, and the name scanned is returned in
+   --  Name_Str (1 .. Name_Len).
+
+   procedure Skip_EOL;
+   --  Called with the current character about to be read being LF or CR. Skips
+   --  past CR/LF characters until either a non-CR/LF character is found, or
+   --  the end of file is encountered.
+
+   procedure Skip_Spaces;
+   --  Skips zero or more spaces at the current position, leaving the file
+   --  positioned at the first non-blank character (or Types.EOF).
+
+   ------------
+   -- At_EOL --
+   ------------
+
+   function At_EOL return Boolean is
+   begin
+      Skip_Spaces;
+      return Nextc = CR or else Nextc = LF;
+   end At_EOL;
+
+   -----------
+   -- Check --
+   -----------
+
+   procedure Check (C : Character) is
+   begin
+      if Nextc = C then
+         Skipc;
+      else
+         raise Data_Error;
+      end if;
+   end Check;
+
+   -------------
+   -- Get_Nat --
+   -------------
+
+   function Get_Nat return Nat is
+      Val : Nat;
+      C   : Character;
+
+   begin
+      C := Nextc;
+      Val := 0;
+
+      if C not in '0' .. '9' then
+         raise Data_Error;
+      end if;
+
+      --  Loop to read digits of integer value
+
+      loop
+         declare
+            pragma Unsuppress (Overflow_Check);
+         begin
+            Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
+         end;
+
+         Skipc;
+         C := Nextc;
+
+         exit when C not in '0' .. '9';
+      end loop;
+
+      return Val;
+
+   exception
+      when Constraint_Error =>
+         raise Data_Error;
+   end Get_Nat;
+
+   --------------
+   -- Get_Name --
+   --------------
+
+   procedure Get_Name is
+      N : Integer;
+
+   begin
+      N := 0;
+      while Nextc > ' ' loop
+         N := N + 1;
+         Name_Str (N) := Getc;
+      end loop;
+
+      Name_Len := N;
+   end Get_Name;
+
+   --------------
+   -- Skip_EOL --
+   --------------
+
+   procedure Skip_EOL is
+      C : Character;
+
+   begin
+      loop
+         Skipc;
+         C := Nextc;
+         exit when C /= LF and then C /= CR;
+
+         if C = ' ' then
+            Skip_Spaces;
+            C := Nextc;
+            exit when C /= LF and then C /= CR;
+         end if;
+      end loop;
+   end Skip_EOL;
+
+   -----------------
+   -- Skip_Spaces --
+   -----------------
+
+   procedure Skip_Spaces is
+   begin
+      while Nextc = ' ' loop
+         Skipc;
+      end loop;
+   end Skip_Spaces;
+
+--  Start of processing for Get_ALFA
+
+begin
+   Initialize_ALFA_Tables;
+
+   Cur_File      := 0;
+   Cur_Scope     := 0;
+   Cur_File_Idx  := 1;
+   Cur_Scope_Idx := 0;
+
+   --  Loop through lines of ALFA information
+
+   while Nextc = 'F' loop
+      Skipc;
+
+      C := Getc;
+
+      --  Make sure first line is a File line
+
+      if ALFA_File_Table.Last = 0 and then C /= 'D' then
+         raise Data_Error;
+      end if;
+
+      --  Otherwise dispatch on type of line
+
+      case C is
+
+         --  Header entry for scope section
+
+         when 'D' =>
+
+            --  Complete previous entry if any
+
+            if ALFA_File_Table.Last /= 0 then
+               ALFA_File_Table.Table (ALFA_File_Table.Last).To_Scope :=
+                 ALFA_Scope_Table.Last;
+            end if;
+
+            --  Scan out dependency number and file name
+
+            Skip_Spaces;
+            Cur_File := Get_Nat;
+            Skip_Spaces;
+            Get_Name;
+
+            --  Make new File table entry (will fill in To_Scope later)
+
+            ALFA_File_Table.Append (
+              (File_Name  => new String'(Name_Str (1 .. Name_Len)),
+               File_Num   => Cur_File,
+               From_Scope => ALFA_Scope_Table.Last + 1,
+               To_Scope   => 0));
+
+            --  Initialize counter for scopes
+
+            Cur_Scope := 1;
+
+         --  Scope entry
+
+         when 'S' =>
+            declare
+               Scope : Nat;
+               Line  : Nat;
+               Col   : Nat;
+               Typ   : Character;
+
+            begin
+               --  Scan out location
+
+               Skip_Spaces;
+               Check ('.');
+               Scope := Get_Nat;
+               Check (' ');
+               Line  := Get_Nat;
+               Typ   := Getc;
+               Col   := Get_Nat;
+
+               pragma Assert (Scope = Cur_Scope);
+               pragma Assert         (Typ = 'K'
+                              or else Typ = 'V'
+                              or else Typ = 'U');
+
+               --  Scan out scope entity name
+
+               Skip_Spaces;
+               Get_Name;
+
+               --  Make new scope table entry (will fill in From_Xref and
+               --  To_Xref later). Initial range (From_Xref .. To_Xref) is
+               --  empty for scopes without entities.
+
+               ALFA_Scope_Table.Append (
+                 (Scope_Entity => Empty,
+                  Scope_Name   => new String'(Name_Str (1 .. Name_Len)),
+                  File_Num     => Cur_File,
+                  Scope_Num    => Cur_Scope,
+                  Line         => Line,
+                  Stype        => Typ,
+                  Col          => Col,
+                  From_Xref    => 1,
+                  To_Xref      => 0));
+            end;
+
+            --  Update counter for scopes
+
+            Cur_Scope := Cur_Scope + 1;
+
+         --  Header entry for cross-ref section
+
+         when 'X' =>
+
+            --  Scan out dependency number and file name (ignored)
+
+            Skip_Spaces;
+            Cur_File := Get_Nat;
+            Skip_Spaces;
+            Get_Name;
+
+            --  Update component From_Xref of current file if first reference
+            --  in this file.
+
+            while ALFA_File_Table.Table (Cur_File_Idx).File_Num /= Cur_File
+            loop
+               Cur_File_Idx := Cur_File_Idx + 1;
+            end loop;
+
+            --  Scan out scope entity number and entity name (ignored)
+
+            Skip_Spaces;
+            Check ('.');
+            Cur_Scope := Get_Nat;
+            Skip_Spaces;
+            Get_Name;
+
+            --  Update component To_Xref of previous scope
+
+            if Cur_Scope_Idx /= 0 then
+               ALFA_Scope_Table.Table (Cur_Scope_Idx).To_Xref :=
+                 ALFA_Xref_Table.Last;
+            end if;
+
+            --  Update component From_Xref of current scope
+
+            Cur_Scope_Idx := ALFA_File_Table.Table (Cur_File_Idx).From_Scope;
+
+            while ALFA_Scope_Table.Table (Cur_Scope_Idx).Scope_Num /= Cur_Scope
+            loop
+               Cur_Scope_Idx := Cur_Scope_Idx + 1;
+            end loop;
+
+            ALFA_Scope_Table.Table (Cur_Scope_Idx).From_Xref :=
+              ALFA_Xref_Table.Last + 1;
+
+         --  Cross reference entry
+
+         when ' ' =>
+            declare
+               XR_Entity      : String_Ptr;
+               XR_Entity_Line : Nat;
+               XR_Entity_Col  : Nat;
+
+               XR_File        : Nat;
+               --  Keeps track of the current file (changed by nn|)
+
+               XR_Scope       : Nat;
+               --  Keeps track of the current scope (changed by nn:)
+
+            begin
+               XR_File  := Cur_File;
+               XR_Scope := Cur_Scope;
+
+               XR_Entity_Line := Get_Nat;
+               Check (' ');
+               XR_Entity_Col  := Get_Nat;
+
+               Skip_Spaces;
+               Get_Name;
+               XR_Entity := new String'(Name_Str (1 .. Name_Len));
+
+               --  Initialize to scan items on one line
+
+               Skip_Spaces;
+
+               --  Loop through cross-references for this entity
+
+               loop
+
+                  declare
+                     Line  : Nat;
+                     Col   : Nat;
+                     N     : Nat;
+                     Rtype : Character;
+
+                  begin
+                     Skip_Spaces;
+
+                     if At_EOL then
+                        Skip_EOL;
+                        exit when Nextc /= '.';
+                        Skipc;
+                     end if;
+
+                     if Nextc = '.' then
+                        Skipc;
+                        XR_Scope := Get_Nat;
+                        Check (':');
+
+                     else
+                        N := Get_Nat;
+
+                        if Nextc = '|' then
+                           XR_File := N;
+                           Skipc;
+
+                        else
+                           Line  := N;
+                           Rtype := Getc;
+                           Col   := Get_Nat;
+
+                           pragma Assert         (Rtype = 'r'
+                                          or else Rtype = 'm'
+                                          or else Rtype = 's');
+
+                           ALFA_Xref_Table.Append (
+                             (Entity_Name => XR_Entity,
+                              Entity_Line => XR_Entity_Line,
+                              Entity_Col  => XR_Entity_Col,
+                              File_Num    => XR_File,
+                              Scope_Num   => XR_Scope,
+                              Line        => Line,
+                              Rtype       => Rtype,
+                              Col         => Col));
+                        end if;
+                     end if;
+                  end;
+               end loop;
+            end;
+
+         --  No other ALFA lines are possible
+
+         when others =>
+            raise Data_Error;
+      end case;
+
+      --  For cross reference lines, the end-of-line character has been skipped
+      --  already.
+
+      if C /= ' ' then
+         Skip_EOL;
+      end if;
+   end loop;
+
+   --  Here with all Xrefs stored, complete last entries in File and Scope
+   --  tables.
+
+   if ALFA_File_Table.Last /= 0 then
+      ALFA_File_Table.Table (ALFA_File_Table.Last).To_Scope :=
+        ALFA_Scope_Table.Last;
+   end if;
+
+   if Cur_Scope_Idx /= 0 then
+      ALFA_Scope_Table.Table (Cur_Scope_Idx).To_Xref := ALFA_Xref_Table.Last;
+   end if;
+end Get_ALFA;