[multiple changes]

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* a-textio.adb: Move new implementation of Get_Line to a subunit.
	* a-tigeli.adb: New subunit containing the implementation of Get_Line.

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_aux.adb: Code clean up.

From-SVN: r165272

4 files changed, 243 insertions, 196 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e8132ab..0959150 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2010-10-11  Javier Miranda  <miranda@adacore.com>
+
+	* a-textio.adb: Move new implementation of Get_Line to a subunit.
+	* a-tigeli.adb: New subunit containing the implementation of Get_Line.
+
+2010-10-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aux.adb: Code clean up.
+
 2010-10-11  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch3.adb, sem_aux.adb, sem_ch6.adb: Minor reformatting
diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb
index 924bfe5..f8538ab 100644
--- a/gcc/ada/a-textio.adb
+++ b/gcc/ada/a-textio.adb
@@ -32,8 +32,6 @@
 with Ada.Streams;             use Ada.Streams;
 with Interfaces.C_Streams;    use Interfaces.C_Streams;
 
-with System;                  use System;
-with System.Storage_Elements; use System.Storage_Elements;
 with System.File_IO;
 with System.CRTL;
 with System.WCh_Cnv;          use System.WCh_Cnv;
@@ -686,197 +684,10 @@ package body Ada.Text_IO is
       Get_Immediate (Current_In, Item, Available);
    end Get_Immediate;
 
-   --------------
-   -- Get_Line --
-   --------------
-
    procedure Get_Line
      (File : File_Type;
       Item : out String;
-      Last : out Natural)
-   is
-      Chunk_Size : constant := 80;
-      --  We read into a fixed size auxiliary buffer. Because this buffer
-      --  needs to be pre-initialized, there is a trade-off between size and
-      --  speed. Experiments find returns are diminishing after 50 and this
-      --  size allows most lines to be processed with a single read.
-
-      ch : int;
-      N  : Natural;
-
-      procedure memcpy (s1, s2 : chars; n : size_t);
-      pragma Import (C, memcpy);
-
-      function memchr (s : chars; ch : int; n : size_t) return chars;
-      pragma Import (C, memchr);
-
-      procedure memset (b : chars; ch : int; n : size_t);
-      pragma Import (C, memset);
-
-      function Get_Chunk (N : Positive) return Natural;
-      --  Reads at most N - 1 characters into Item (Last + 1 .. Item'Last),
-      --  updating Last. Raises End_Error if nothing was read (End_Of_File).
-      --  Returns number of characters still to read (either 0 or 1) in
-      --  case of success.
-
-      ---------------
-      -- Get_Chunk --
-      ---------------
-
-      function Get_Chunk (N : Positive) return Natural is
-         Buf : String (1 .. Chunk_Size);
-         S   : constant chars := Buf (1)'Address;
-         P   : chars;
-
-      begin
-         if N = 1 then
-            return N;
-         end if;
-
-         memset (S, 10, size_t (N));
-
-         if fgets (S, N, File.Stream) = Null_Address then
-            if ferror (File.Stream) /= 0 then
-               raise Device_Error;
-
-            --  If incomplete last line, pretend we found a LM
-
-            elsif Last >= Item'First then
-               return 0;
-
-            else
-               raise End_Error;
-            end if;
-         end if;
-
-         P := memchr (S, LM, size_t (N));
-
-         --  If no LM is found, the buffer got filled without reading a new
-         --  line. Otherwise, the LM is either one from the input, or else one
-         --  from the initialization, which means an incomplete end-of-line was
-         --  encountered. Only in first case the LM will be followed by a 0.
-
-         if P = Null_Address then
-            pragma Assert (Buf (N) = ASCII.NUL);
-            memcpy (Item (Last + 1)'Address,
-                    Buf (1)'Address, size_t (N - 1));
-            Last := Last + N - 1;
-
-            return 1;
-
-         else
-            --  P points to the LM character. Set K so Buf (K) is the character
-            --  right before.
-
-            declare
-               K : Natural := Natural (P - S);
-
-            begin
-               --  Now Buf (K + 2) should be 0, or otherwise Buf (K) is the 0
-               --  put in by fgets, so compensate.
-
-               if K + 2 > Buf'Last or else Buf (K + 2) /= ASCII.NUL then
-
-                  --  Incomplete last line, so remove the extra 0
-
-                  pragma Assert (Buf (K) = ASCII.NUL);
-                  K := K - 1;
-               end if;
-
-               memcpy (Item (Last + 1)'Address,
-                       Buf (1)'Address, size_t (K));
-               Last := Last + K;
-            end;
-
-            return 0;
-         end if;
-      end Get_Chunk;
-
-   --  Start of processing for Get_Line
-
-   begin
-      FIO.Check_Read_Status (AP (File));
-
-      --  Immediate exit for null string, this is a case in which we do not
-      --  need to test for end of file and we do not skip a line mark under
-      --  any circumstances.
-
-      if Item'First > Item'Last then
-         return;
-      end if;
-
-      N := Item'Last - Item'First + 1;
-
-      Last := Item'First - 1;
-
-      --  Here we have at least one character, if we are immediately before
-      --  a line mark, then we will just skip past it storing no characters.
-
-      if File.Before_LM then
-         File.Before_LM := False;
-         File.Before_LM_PM := False;
-
-      --  Otherwise we need to read some characters
-
-      else
-         while N >= Chunk_Size loop
-            if Get_Chunk (Chunk_Size) = 0 then
-               N := 0;
-            else
-               N := N - Chunk_Size + 1;
-            end if;
-         end loop;
-
-         if N > 1 then
-            N := Get_Chunk (N);
-         end if;
-
-         --  Almost there, only a little bit more to read
-
-         if N = 1 then
-            ch := Getc (File);
-
-            --  If we get EOF after already reading data, this is an incomplete
-            --  last line, in which case no End_Error should be raised.
-
-            if ch = EOF and then Last < Item'First then
-               raise End_Error;
-
-            elsif ch /= LM then
-
-               --  Buffer really is full without having seen LM, update col
-
-               Last := Last + 1;
-               Item (Last) := Character'Val (ch);
-               File.Col := File.Col + Count (Last - Item'First + 1);
-               return;
-            end if;
-         end if;
-      end if;
-
-      --  We have skipped past, but not stored, a line mark. Skip following
-      --  page mark if one follows, but do not do this for a non-regular file
-      --  (since otherwise we get annoying wait for an extra character)
-
-      File.Line := File.Line + 1;
-      File.Col := 1;
-
-      if File.Before_LM_PM then
-         File.Line := 1;
-         File.Before_LM_PM := False;
-         File.Page := File.Page + 1;
-
-      elsif File.Is_Regular_File then
-         ch := Getc (File);
-
-         if ch = PM and then File.Is_Regular_File then
-            File.Line := 1;
-            File.Page := File.Page + 1;
-         else
-            Ungetc (ch, File);
-         end if;
-      end if;
-   end Get_Line;
+      Last : out Natural) is separate;
 
    procedure Get_Line
      (Item : out String;
diff --git a/gcc/ada/a-tigeli.adb b/gcc/ada/a-tigeli.adb
new file mode 100644
index 0000000..f37ccb4
--- /dev/null
+++ b/gcc/ada/a-tigeli.adb
@@ -0,0 +1,224 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                          A D A . T E X T _ I O                           --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-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- --
+-- ware  Foundation;  either version 2,  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 COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System;                  use System;
+with System.Storage_Elements; use System.Storage_Elements;
+
+separate (Ada.Text_IO)
+procedure Get_Line
+  (File : File_Type;
+   Item : out String;
+   Last : out Natural)
+is
+   Chunk_Size : constant := 80;
+   --  We read into a fixed size auxiliary buffer. Because this buffer
+   --  needs to be pre-initialized, there is a trade-off between size and
+   --  speed. Experiments find returns are diminishing after 50 and this
+   --  size allows most lines to be processed with a single read.
+
+   ch : int;
+   N  : Natural;
+
+   procedure memcpy (s1, s2 : chars; n : size_t);
+   pragma Import (C, memcpy);
+
+   function memchr (s : chars; ch : int; n : size_t) return chars;
+   pragma Import (C, memchr);
+
+   procedure memset (b : chars; ch : int; n : size_t);
+   pragma Import (C, memset);
+
+   function Get_Chunk (N : Positive) return Natural;
+   --  Reads at most N - 1 characters into Item (Last + 1 .. Item'Last),
+   --  updating Last. Raises End_Error if nothing was read (End_Of_File).
+   --  Returns number of characters still to read (either 0 or 1) in
+   --  case of success.
+
+   ---------------
+   -- Get_Chunk --
+   ---------------
+
+   function Get_Chunk (N : Positive) return Natural is
+      Buf : String (1 .. Chunk_Size);
+      S   : constant chars := Buf (1)'Address;
+      P   : chars;
+
+   begin
+      if N = 1 then
+         return N;
+      end if;
+
+      memset (S, 10, size_t (N));
+
+      if fgets (S, N, File.Stream) = Null_Address then
+         if ferror (File.Stream) /= 0 then
+            raise Device_Error;
+
+         --  If incomplete last line, pretend we found a LM
+
+         elsif Last >= Item'First then
+            return 0;
+
+         else
+            raise End_Error;
+         end if;
+      end if;
+
+      P := memchr (S, LM, size_t (N));
+
+      --  If no LM is found, the buffer got filled without reading a new
+      --  line. Otherwise, the LM is either one from the input, or else one
+      --  from the initialization, which means an incomplete end-of-line was
+      --  encountered. Only in first case the LM will be followed by a 0.
+
+      if P = Null_Address then
+         pragma Assert (Buf (N) = ASCII.NUL);
+         memcpy (Item (Last + 1)'Address,
+                 Buf (1)'Address, size_t (N - 1));
+         Last := Last + N - 1;
+
+         return 1;
+
+      else
+         --  P points to the LM character. Set K so Buf (K) is the character
+         --  right before.
+
+         declare
+            K : Natural := Natural (P - S);
+
+         begin
+            --  Now Buf (K + 2) should be 0, or otherwise Buf (K) is the 0
+            --  put in by fgets, so compensate.
+
+            if K + 2 > Buf'Last or else Buf (K + 2) /= ASCII.NUL then
+
+               --  Incomplete last line, so remove the extra 0
+
+               pragma Assert (Buf (K) = ASCII.NUL);
+               K := K - 1;
+            end if;
+
+            memcpy (Item (Last + 1)'Address,
+                    Buf (1)'Address, size_t (K));
+            Last := Last + K;
+         end;
+
+         return 0;
+      end if;
+   end Get_Chunk;
+
+--  Start of processing for Get_Line
+
+begin
+   FIO.Check_Read_Status (AP (File));
+
+   --  Immediate exit for null string, this is a case in which we do not
+   --  need to test for end of file and we do not skip a line mark under
+   --  any circumstances.
+
+   if Item'First > Item'Last then
+      return;
+   end if;
+
+   N := Item'Last - Item'First + 1;
+
+   Last := Item'First - 1;
+
+   --  Here we have at least one character, if we are immediately before
+   --  a line mark, then we will just skip past it storing no characters.
+
+   if File.Before_LM then
+      File.Before_LM := False;
+      File.Before_LM_PM := False;
+
+   --  Otherwise we need to read some characters
+
+   else
+      while N >= Chunk_Size loop
+         if Get_Chunk (Chunk_Size) = 0 then
+            N := 0;
+         else
+            N := N - Chunk_Size + 1;
+         end if;
+      end loop;
+
+      if N > 1 then
+         N := Get_Chunk (N);
+      end if;
+
+      --  Almost there, only a little bit more to read
+
+      if N = 1 then
+         ch := Getc (File);
+
+         --  If we get EOF after already reading data, this is an incomplete
+         --  last line, in which case no End_Error should be raised.
+
+         if ch = EOF and then Last < Item'First then
+            raise End_Error;
+
+         elsif ch /= LM then
+
+            --  Buffer really is full without having seen LM, update col
+
+            Last := Last + 1;
+            Item (Last) := Character'Val (ch);
+            File.Col := File.Col + Count (Last - Item'First + 1);
+            return;
+         end if;
+      end if;
+   end if;
+
+   --  We have skipped past, but not stored, a line mark. Skip following
+   --  page mark if one follows, but do not do this for a non-regular file
+   --  (since otherwise we get annoying wait for an extra character)
+
+   File.Line := File.Line + 1;
+   File.Col := 1;
+
+   if File.Before_LM_PM then
+      File.Line := 1;
+      File.Before_LM_PM := False;
+      File.Page := File.Page + 1;
+
+   elsif File.Is_Regular_File then
+      ch := Getc (File);
+
+      if ch = PM and then File.Is_Regular_File then
+         File.Line := 1;
+         File.Page := File.Page + 1;
+      else
+         Ungetc (ch, File);
+      end if;
+   end if;
+end Get_Line;
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index b670d43..7bda710 100755
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -578,7 +578,10 @@ package body Sem_Aux is
       Btype : constant Entity_Id := Base_Type (Ent);
 
    begin
-      if Ekind (Btype) = E_Limited_Private_Type
+      if Is_Limited_Record (Btype) then
+         return True;
+
+      elsif Ekind (Btype) = E_Limited_Private_Type
         and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
       then
          return not In_Package_Body (Scope ((Btype)));
@@ -595,8 +598,11 @@ package body Sem_Aux is
             if not Is_Limited_Type (Etype (Btype)) then
                return False;
 
+            --  A descendant of a limited formal type is not immutably limited
+            --  in the generic body, or in the body of a generic child.
+
             elsif Ekind (Scope (Etype (Btype))) = E_Generic_Package then
-               return not In_Package_Body (Scope (Etype (Btype)));
+               return not In_Package_Body (Scope (Btype));
 
             else
                return False;
@@ -626,10 +632,7 @@ package body Sem_Aux is
          --  handled as build in place even though they might return objects
          --  of a type that is not inherently limited.
 
-         if Is_Limited_Record (Btype) then
-            return True;
-
-         elsif Is_Class_Wide_Type (Btype) then
+         if Is_Class_Wide_Type (Btype) then
             return Is_Immutably_Limited_Type (Root_Type (Btype));
 
          else