[multiple changes]

2014-07-30  Arnaud Charlet  <charlet@adacore.com>

	* set_targ.adb (Read_Target_Dependent_Values): New subprogram.
	(elab body): Add provision for default target config file.
	* get_targ.ads, get_targ.adb (Get_Back_End_Config_File): New subprogram.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* a-cbhase.adb (Delete): Raise Constraint_Error, not Program_Error,
	when attempting to remove an element not in the set. This is
	the given semantics for all set containers.
	* a-cborse.adb (Delete): Attempt removal first, to check for
	tampering, before checking whether this is an attempt to
	delete a  non-existing element, and in fthe latter case raise
	Constraint_Error.

2014-07-30  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb (Recursive_Process): Do not create a new
	Project_Id if the project is already in the list of projects of
	the tree.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Function_Return): Reject a return expression
	whose type is an incomplete formal type.
	(Analyze_Return_Type): Reject a return type that is an untagged
	imcomplete formal type.
	(Process_Formals): Reject a formal parameter whose type is an
	untagged formal incomplete type.
	* sem_res.adb (Resolve_Actuals): Reject an actual whose type is
	an untagged formal incomplete type.

From-SVN: r213299

1 files changed, 296 insertions, 279 deletions

diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb
index d6268c8..704bea6 100755
--- a/gcc/ada/set_targ.adb
+++ b/gcc/ada/set_targ.adb
@@ -130,6 +130,10 @@ package body Set_Targ is
    -- Local Subprograms --
    -----------------------
 
+   procedure Read_Target_Dependent_Values (File_Name : String);
+   --  Read target dependent values from File_Name, and set the target
+   --  dependent values (global variables) declared in this package.
+
    procedure Fail (E : String);
    pragma No_Return (Fail);
    --  Terminate program with fatal error message passed as parameter
@@ -481,6 +485,260 @@ package body Set_Targ is
       end if;
    end Write_Target_Dependent_Values;
 
+   ----------------------------------
+   -- Read_Target_Dependent_Values --
+   ----------------------------------
+
+   procedure Read_Target_Dependent_Values (File_Name : String) is
+      File_Desc : File_Descriptor;
+      N         : Natural;
+
+      type ANat is access all Natural;
+      --  Pointer to Nat or Pos value (it is harmless to treat Pos values
+      --  as Nat via Unchecked_Conversion).
+
+      function To_ANat is new Unchecked_Conversion (Address, ANat);
+
+      VP : ANat;
+
+      Buffer : String (1 .. 2000);
+      Buflen : Natural;
+      --  File information and length (2000 easily enough)
+
+      Nam_Buf : String (1 .. 40);
+      Nam_Len : Natural;
+
+      procedure Check_Spaces;
+      --  Checks that we have one or more spaces and skips them
+
+      procedure FailN (S : String);
+      --  Calls Fail adding " name in file xxx", where name is the currently
+      --  gathered name in Nam_Buf, surrounded by quotes, and xxx is the
+      --  name of the file.
+
+      procedure Get_Name;
+      --  Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls
+      --  Skip_Spaces to skip any following spaces. Note that the name is
+      --  terminated by a sequence of at least two spaces.
+
+      function Get_Nat return Natural;
+      --  N on entry points to decimal integer, scan out decimal integer
+      --  and return it, leaving N pointing to following space or LF.
+
+      procedure Skip_Spaces;
+      --  Skip past spaces
+
+      ------------------
+      -- Check_Spaces --
+      ------------------
+
+      procedure Check_Spaces is
+      begin
+         if N > Buflen or else Buffer (N) /= ' ' then
+            FailN ("missing space for");
+         end if;
+
+         Skip_Spaces;
+         return;
+      end Check_Spaces;
+
+      -----------
+      -- FailN --
+      -----------
+
+      procedure FailN (S : String) is
+      begin
+         Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file "
+               & File_Name);
+      end FailN;
+
+      --------------
+      -- Get_Name --
+      --------------
+
+      procedure Get_Name is
+      begin
+         Nam_Len := 0;
+
+         --  Scan out name and put it in Nam_Buf
+
+         loop
+            if N > Buflen or else Buffer (N) = ASCII.LF then
+               FailN ("incorrectly formatted line for");
+            end if;
+
+            --  Name is terminated by two blanks
+
+            exit when N < Buflen and then Buffer (N .. N + 1) = "  ";
+
+            Nam_Len := Nam_Len + 1;
+
+            if Nam_Len > Nam_Buf'Last then
+               Fail ("name too long");
+            end if;
+
+            Nam_Buf (Nam_Len) := Buffer (N);
+            N := N + 1;
+         end loop;
+
+         Check_Spaces;
+      end Get_Name;
+
+      -------------
+      -- Get_Nat --
+      -------------
+
+      function Get_Nat return Natural is
+         Result : Natural := 0;
+
+      begin
+         loop
+            if N > Buflen
+              or else Buffer (N) not in '0' .. '9'
+              or else Result > 999
+            then
+               FailN ("bad value for");
+            end if;
+
+            Result := Result * 10 + (Character'Pos (Buffer (N)) - 48);
+            N := N + 1;
+
+            exit when N <= Buflen
+              and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' ');
+         end loop;
+
+         return Result;
+      end Get_Nat;
+
+      -----------------
+      -- Skip_Spaces --
+      -----------------
+
+      procedure Skip_Spaces is
+      begin
+         while N <= Buflen and Buffer (N) = ' ' loop
+            N := N + 1;
+         end loop;
+      end Skip_Spaces;
+
+   --  Start of processing for Read_Target_Dependent_Values
+
+   begin
+      File_Desc := Open_Read (File_Name, Text);
+
+      if File_Desc = Invalid_FD then
+         Fail ("cannot read file " & File_Name);
+      end if;
+
+      Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);
+
+      if Buflen = Buffer'Length then
+         Fail ("file is too long: " & File_Name);
+      end if;
+
+      --  Scan through file for properly formatted entries in first section
+
+      N := 1;
+      while N <= Buflen and then Buffer (N) /= ASCII.LF loop
+         Get_Name;
+
+         --  Validate name and get corresponding value pointer
+
+         VP := null;
+
+         for J in DTN'Range loop
+            if DTN (J).all = Nam_Buf (1 .. Nam_Len) then
+               VP := To_ANat (DTV (J));
+               DTR (J) := True;
+               exit;
+            end if;
+         end loop;
+
+         if VP = null then
+            FailN ("unrecognized name");
+         end if;
+
+         --  Scan out value
+
+         VP.all := Get_Nat;
+
+         if N > Buflen or else Buffer (N) /= ASCII.LF then
+            FailN ("misformatted line for");
+         end if;
+
+         N := N + 1; -- skip LF
+      end loop;
+
+      --  Fall through this loop when all lines in first section read.
+      --  Check that values have been supplied for all entries.
+
+      for J in DTR'Range loop
+         if not DTR (J) then
+            Fail ("missing entry for " & DTN (J).all & " in file "
+                  & File_Name);
+         end if;
+      end loop;
+
+      --  Now acquire FPT entries
+
+      if N >= Buflen then
+         Fail ("missing entries for FPT modes in file " & File_Name);
+      end if;
+
+      if Buffer (N) = ASCII.LF then
+         N := N + 1;
+      else
+         Fail ("missing blank line in file " & File_Name);
+      end if;
+
+      Num_FPT_Modes := 0;
+      while N <= Buflen loop
+         Get_Name;
+
+         Num_FPT_Modes := Num_FPT_Modes + 1;
+
+         declare
+            E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes);
+
+         begin
+            E.NAME := new String'(Nam_Buf (1 .. Nam_Len));
+
+            E.DIGS := Get_Nat;
+            Check_Spaces;
+
+            case Buffer (N) is
+               when 'I'    =>
+                  E.FLOAT_REP := IEEE_Binary;
+               when 'V'    =>
+                  E.FLOAT_REP := VAX_Native;
+               when 'A'    =>
+                  E.FLOAT_REP := AAMP;
+               when others =>
+                  FailN ("bad float rep field for");
+            end case;
+
+            N := N + 1;
+            Check_Spaces;
+
+            E.PRECISION := Get_Nat;
+            Check_Spaces;
+
+            E.ALIGNMENT := Get_Nat;
+
+            if Buffer (N) /= ASCII.LF then
+               FailN ("junk at end of line for");
+            end if;
+
+            --  ??? We do not read E.SIZE, see Write_Target_Dependent_Values
+
+            E.SIZE :=
+              (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT;
+
+            N := N + 1;
+         end;
+      end loop;
+   end Read_Target_Dependent_Values;
+
 --  Package Initialization, set target dependent values. This must be done
 --  early on, before we start accessing various compiler packages, since
 --  these values are used all over the place.
@@ -565,40 +823,6 @@ begin
       end loop;
    end;
 
-   --  If the switch is not set, we get all values from the back end
-
-   if Opt.Target_Dependent_Info_Read_Name = null then
-
-      --  Set values by direct calls to the back end
-
-      Bits_BE                    := Get_Bits_BE;
-      Bits_Per_Unit              := Get_Bits_Per_Unit;
-      Bits_Per_Word              := Get_Bits_Per_Word;
-      Bytes_BE                   := Get_Bytes_BE;
-      Char_Size                  := Get_Char_Size;
-      Double_Float_Alignment     := Get_Double_Float_Alignment;
-      Double_Scalar_Alignment    := Get_Double_Scalar_Alignment;
-      Double_Size                := Get_Double_Size;
-      Float_Size                 := Get_Float_Size;
-      Float_Words_BE             := Get_Float_Words_BE;
-      Int_Size                   := Get_Int_Size;
-      Long_Double_Size           := Get_Long_Double_Size;
-      Long_Long_Size             := Get_Long_Long_Size;
-      Long_Size                  := Get_Long_Size;
-      Maximum_Alignment          := Get_Maximum_Alignment;
-      Max_Unaligned_Field        := Get_Max_Unaligned_Field;
-      Pointer_Size               := Get_Pointer_Size;
-      Short_Enums                := Get_Short_Enums;
-      Short_Size                 := Get_Short_Size;
-      Strict_Alignment           := Get_Strict_Alignment;
-      System_Allocator_Alignment := Get_System_Allocator_Alignment;
-      Wchar_T_Size               := Get_Wchar_T_Size;
-      Words_BE                   := Get_Words_BE;
-
-      --  Register floating-point types from the back end
-
-      Register_Back_End_Types (Register_Float_Type'Access);
-
    --  Case of reading the target dependent values from file
 
    --  This is bit more complex than might be expected, because it has to be
@@ -607,257 +831,50 @@ begin
    --  etc to read the file. We do this at the System.OS_Lib level since it is
    --  too early to be using Osint directly.
 
+   if Opt.Target_Dependent_Info_Read_Name /= null then
+      Read_Target_Dependent_Values (Target_Dependent_Info_Read_Name.all);
    else
-      Read_Target_Dependent_Values : declare
-         File_Desc : File_Descriptor;
-         N         : Natural;
-
-         type ANat is access all Natural;
-         --  Pointer to Nat or Pos value (it is harmless to treat Pos values
-         --  as Nat via Unchecked_Conversion).
-
-         function To_ANat is new Unchecked_Conversion (Address, ANat);
-
-         VP : ANat;
-
-         Buffer : String (1 .. 2000);
-         Buflen : Natural;
-         --  File information and length (2000 easily enough)
-
-         Nam_Buf : String (1 .. 40);
-         Nam_Len : Natural;
-
-         procedure Check_Spaces;
-         --  Checks that we have one or more spaces and skips them
-
-         procedure FailN (S : String);
-         --  Calls Fail adding " name in file xxx", where name is the currently
-         --  gathered name in Nam_Buf, surrounded by quotes, and xxx is the
-         --  name of the file.
-
-         procedure Get_Name;
-         --  Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls
-         --  Skip_Spaces to skip any following spaces. Note that the name is
-         --  terminated by a sequence of at least two spaces.
-
-         function Get_Nat return Natural;
-         --  N on entry points to decimal integer, scan out decimal integer
-         --  and return it, leaving N pointing to following space or LF.
-
-         procedure Skip_Spaces;
-         --  Skip past spaces
-
-         ------------------
-         -- Check_Spaces --
-         ------------------
-
-         procedure Check_Spaces is
-         begin
-            if N > Buflen or else Buffer (N) /= ' ' then
-               FailN ("missing space for");
-            end if;
-
-            Skip_Spaces;
-            return;
-         end Check_Spaces;
-
-         -----------
-         -- FailN --
-         -----------
-
-         procedure FailN (S : String) is
-         begin
-            Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file "
-                  & Target_Dependent_Info_Read_Name.all);
-         end FailN;
-
-         --------------
-         -- Get_Name --
-         --------------
-
-         procedure Get_Name is
-         begin
-            Nam_Len := 0;
-
-            --  Scan out name and put it in Nam_Buf
-
-            loop
-               if N > Buflen or else Buffer (N) = ASCII.LF then
-                  FailN ("incorrectly formatted line for");
-               end if;
-
-               --  Name is terminated by two blanks
-
-               exit when N < Buflen and then Buffer (N .. N + 1) = "  ";
-
-               Nam_Len := Nam_Len + 1;
-
-               if Nam_Len > Nam_Buf'Last then
-                  Fail ("name too long");
-               end if;
-
-               Nam_Buf (Nam_Len) := Buffer (N);
-               N := N + 1;
-            end loop;
-
-            Check_Spaces;
-         end Get_Name;
-
-         -------------
-         -- Get_Nat --
-         -------------
-
-         function Get_Nat return Natural is
-            Result : Natural := 0;
-
-         begin
-            loop
-               if N > Buflen
-                 or else Buffer (N) not in '0' .. '9'
-                 or else Result > 999
-               then
-                  FailN ("bad value for");
-               end if;
-
-               Result := Result * 10 + (Character'Pos (Buffer (N)) - 48);
-               N := N + 1;
-
-               exit when N <= Buflen
-                 and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' ');
-            end loop;
-
-            return Result;
-         end Get_Nat;
-
-         -----------------
-         -- Skip_Spaces --
-         -----------------
-
-         procedure Skip_Spaces is
-         begin
-            while N <= Buflen and Buffer (N) = ' ' loop
-               N := N + 1;
-            end loop;
-         end Skip_Spaces;
-
-      --  Start of processing for Read_Target_Dependent_Values
+      --  If the back-end comes with a target config file, then use it
+      --  to set the values
 
+      declare
+         Back_End_Config_File : constant String_Ptr :=
+           Get_Back_End_Config_File;
       begin
-         File_Desc := Open_Read (Target_Dependent_Info_Read_Name.all, Text);
-
-         if File_Desc = Invalid_FD then
-            Fail ("cannot read file " & Target_Dependent_Info_Read_Name.all);
-         end if;
-
-         Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);
+         if Back_End_Config_File /= null then
+            Read_Target_Dependent_Values (Back_End_Config_File.all);
 
-         if Buflen = Buffer'Length then
-            Fail ("file is too long: " & Target_Dependent_Info_Read_Name.all);
-         end if;
-
-         --  Scan through file for properly formatted entries in first section
-
-         N := 1;
-         while N <= Buflen and then Buffer (N) /= ASCII.LF loop
-            Get_Name;
-
-            --  Validate name and get corresponding value pointer
-
-            VP := null;
-
-            for J in DTN'Range loop
-               if DTN (J).all = Nam_Buf (1 .. Nam_Len) then
-                  VP := To_ANat (DTV (J));
-                  DTR (J) := True;
-                  exit;
-               end if;
-            end loop;
-
-            if VP = null then
-               FailN ("unrecognized name");
-            end if;
-
-            --  Scan out value
-
-            VP.all := Get_Nat;
-
-            if N > Buflen or else Buffer (N) /= ASCII.LF then
-               FailN ("misformatted line for");
-            end if;
+         --  Otherwise we get all values from the back end directly
 
-            N := N + 1; -- skip LF
-         end loop;
-
-         --  Fall through this loop when all lines in first section read.
-         --  Check that values have been supplied for all entries.
-
-         for J in DTR'Range loop
-            if not DTR (J) then
-               Fail ("missing entry for " & DTN (J).all & " in file "
-                     & Target_Dependent_Info_Read_Name.all);
-            end if;
-         end loop;
-
-         --  Now acquire FPT entries
-
-         if N >= Buflen then
-            Fail ("missing entries for FPT modes in file "
-                  & Target_Dependent_Info_Read_Name.all);
-         end if;
-
-         if Buffer (N) = ASCII.LF then
-            N := N + 1;
          else
-            Fail ("missing blank line in file "
-                  & Target_Dependent_Info_Read_Name.all);
+            Bits_BE                    := Get_Bits_BE;
+            Bits_Per_Unit              := Get_Bits_Per_Unit;
+            Bits_Per_Word              := Get_Bits_Per_Word;
+            Bytes_BE                   := Get_Bytes_BE;
+            Char_Size                  := Get_Char_Size;
+            Double_Float_Alignment     := Get_Double_Float_Alignment;
+            Double_Scalar_Alignment    := Get_Double_Scalar_Alignment;
+            Double_Size                := Get_Double_Size;
+            Float_Size                 := Get_Float_Size;
+            Float_Words_BE             := Get_Float_Words_BE;
+            Int_Size                   := Get_Int_Size;
+            Long_Double_Size           := Get_Long_Double_Size;
+            Long_Long_Size             := Get_Long_Long_Size;
+            Long_Size                  := Get_Long_Size;
+            Maximum_Alignment          := Get_Maximum_Alignment;
+            Max_Unaligned_Field        := Get_Max_Unaligned_Field;
+            Pointer_Size               := Get_Pointer_Size;
+            Short_Enums                := Get_Short_Enums;
+            Short_Size                 := Get_Short_Size;
+            Strict_Alignment           := Get_Strict_Alignment;
+            System_Allocator_Alignment := Get_System_Allocator_Alignment;
+            Wchar_T_Size               := Get_Wchar_T_Size;
+            Words_BE                   := Get_Words_BE;
+
+            --  Register floating-point types from the back end
+
+            Register_Back_End_Types (Register_Float_Type'Access);
          end if;
-
-         Num_FPT_Modes := 0;
-         while N <= Buflen loop
-            Get_Name;
-
-            Num_FPT_Modes := Num_FPT_Modes + 1;
-
-            declare
-               E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes);
-
-            begin
-               E.NAME := new String'(Nam_Buf (1 .. Nam_Len));
-
-               E.DIGS := Get_Nat;
-               Check_Spaces;
-
-               case Buffer (N) is
-                  when 'I'    =>
-                     E.FLOAT_REP := IEEE_Binary;
-                  when 'V'    =>
-                     E.FLOAT_REP := VAX_Native;
-                  when 'A'    =>
-                     E.FLOAT_REP := AAMP;
-                  when others =>
-                     FailN ("bad float rep field for");
-               end case;
-
-               N := N + 1;
-               Check_Spaces;
-
-               E.PRECISION := Get_Nat;
-               Check_Spaces;
-
-               E.ALIGNMENT := Get_Nat;
-
-               if Buffer (N) /= ASCII.LF then
-                  FailN ("junk at end of line for");
-               end if;
-
-               --  ??? We do not read E.SIZE, see Write_Target_Dependent_Values
-
-               E.SIZE :=
-                 (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT;
-
-               N := N + 1;
-            end;
-         end loop;
-      end Read_Target_Dependent_Values;
+      end;
    end if;
 end Set_Targ;