landgraf pushed to gprbuild (master). "Fix library version"
notifications at fedoraproject.org
notifications at fedoraproject.org
Sun Mar 29 20:06:27 UTC 2015
>From f10e5346d81a0c9f97cadd9d24539c4920c40cb4 Mon Sep 17 00:00:00 2001
From: Pavel Zhukov <landgraf at fedoraproject.org>
Date: Sun, 29 Mar 2015 22:06:13 +0200
Subject: Fix library version
diff --git a/gprbuild-2014-destdir.patch b/gprbuild-2014-destdir.patch
index 3bff2e8..05a75e7 100644
--- a/gprbuild-2014-destdir.patch
+++ b/gprbuild-2014-destdir.patch
@@ -15,3 +15,25 @@ index 140c5dd..221e230 100644
${RM} -r ${datadir}/doc/gprbuild
-${MKDIR} ${datadir}/doc/gprbuild
for format in html txt pdf info; do \
+diff --git a/Makefile.in b/Makefile.in
+index 62e34b3..bc66d58 100644
+--- a/Makefile.in
++++ b/Makefile.in
+@@ -37,7 +37,7 @@ xmlada_build_target=@xmlada_build_target@
+ xmlada_prj_flags=@xmlada_prj_flags@
+
+ # How do we want to use XML/Ada ?
+-LIBRARY_TYPE=static
++LIBRARY_TYPE=relocatable
+ export LIBRARY_TYPE
+
+ objdir=obj
+@@ -55,7 +55,7 @@ dummy:=$(shell $(MKDIR) $(objdir))
+
+ PROCESSORS ?= 0
+
+-GNATMAKE=gnatmake -p -m -j${PROCESSORS}
++GNATMAKE=gnatmake -p -m ${GNATOPTFLAGS}
+ ifeq ($(strip $(filter-out %vms%,$(host))),)
+ GNATMAKE=${GNATMAKE} -XOS=vms
+ endif
diff --git a/gprbuild-2014-gcc.patch b/gprbuild-2014-gcc.patch
deleted file mode 100644
index 051dd20..0000000
--- a/gprbuild-2014-gcc.patch
+++ /dev/null
@@ -1,19472 +0,0 @@
-diff --git a/gnat/Make-generated.in b/gnat/Make-generated.in
-index 412e18b..757eaa8 100644
---- a/gnat/Make-generated.in
-+++ b/gnat/Make-generated.in
-@@ -66,48 +66,6 @@ $(ADA_GEN_SUBDIR)/stamp-nmake: $(ADA_GEN_SUBDIR)/sinfo.ads $(ADA_GEN_SUBDIR)/nma
- $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/nmake/nmake.adb $(ADA_GEN_SUBDIR)/nmake.adb
- touch $(ADA_GEN_SUBDIR)/stamp-nmake
-
--# GCC_FOR_TARGET has paths relative to the gcc directory, so we need to adjust
--# for running it from $(ADA_GEN_SUBDIR)/bldtools/oscons.
--
--OSCONS_CC=$(subst ./xgcc,../../../xgcc,$(subst -B./, -B../../../,$(GCC_FOR_TARGET)))
--
--# The main ada source directory must be on the include path for #include "..."
--# because s-oscons-tmplt.c requires adaint.h, gsocket.h, and any file included
--# by these headers. However note that we must use -iquote, not -I, so that
--# ada/types.h does not conflict with a same-named system header (VxWorks
--# has a <types.h> header).
--
--OSCONS_SRCDIR=$${_oscons_srcdir}
--OSCONS_CPP=$(OSCONS_CC) $(GNATLIBCFLAGS) -E -C \
-- -DTARGET=\"$(target)\" -iquote $(OSCONS_SRCDIR) s-oscons-tmplt.c > s-oscons-tmplt.i
--OSCONS_EXTRACT=$(OSCONS_CC) -iquote $(OSCONS_SRCDIR) -S s-oscons-tmplt.i
--
--# Note: if you need to build with a non-GNU compiler, you could adapt the
--# following definitions (written for VMS DEC-C)
--#OSCONS_CPP=../../../$(DECC) -E /comment=as_is -DNATIVE \
--# -DTARGET='""$(target)""' -I$(OSCONS_SRCDIR) s-oscons-tmplt.c
--#
--#OSCONS_EXTRACT=../../../$(DECC) -DNATIVE \
--# -DTARGET='""$(target)""' -I$(OSCONS_SRCDIR) s-oscons-tmplt.c ; \
--# ld -o s-oscons-tmplt.exe s-oscons-tmplt.obj; \
--# ./s-oscons-tmplt.exe > s-oscons-tmplt.s
--
--# Note: the first dependency of s-oscons.ads *must* remain s-oscons-tmplt.c, as
--# we use $(<D) to locate the main ada/ source directory and pass it to OSCONS_CPP
--# as a -I argument.
--$(ADA_GEN_SUBDIR)/s-oscons.ads : $(ADA_GEN_SUBDIR)/s-oscons-tmplt.c $(ADA_GEN_SUBDIR)/xoscons.adb $(ADA_GEN_SUBDIR)/xutil.ads $(ADA_GEN_SUBDIR)/xutil.adb
-- -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/oscons
-- $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/oscons/,$(notdir $^))
-- $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/oscons
-- _oscons_srcdir=`cd $(<D) && pwd` ; \
-- (cd $(ADA_GEN_SUBDIR)/bldtools/oscons ; gnatmake -q xoscons ; \
-- $(RM) s-oscons-tmplt.i s-oscons-tmplt.s ; \
-- $(OSCONS_CPP) ; \
-- $(OSCONS_EXTRACT) ; \
-- ./xoscons s-oscons ) ; \
-- $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/oscons/s-oscons.ads $(ADA_GEN_SUBDIR)/s-oscons.ads ; \
-- $(MOVE_IF_CHANGE) $(ADA_GEN_SUBDIR)/bldtools/oscons/s-oscons.h $(ADA_GEN_SUBDIR)/s-oscons.h
--
- $(ADA_GEN_SUBDIR)/sdefault.adb: $(ADA_GEN_SUBDIR)/stamp-sdefault ; @true
- $(ADA_GEN_SUBDIR)/stamp-sdefault : $(srcdir)/version.c Makefile
- $(ECHO) "pragma Style_Checks (Off);" >tmp-sdefault.adb
-@@ -137,11 +95,3 @@ $(ADA_GEN_SUBDIR)/stamp-sdefault : $(srcdir)/version.c Makefile
- $(ECHO) "end Sdefault;" >> tmp-sdefault.adb
- $(MOVE_IF_CHANGE) tmp-sdefault.adb $(ADA_GEN_SUBDIR)/sdefault.adb
- touch $(ADA_GEN_SUBDIR)/stamp-sdefault
--
--$(ADA_GEN_SUBDIR)/gnat.hlp : $(ADA_GEN_SUBDIR)/vms_help.adb $(ADA_GEN_SUBDIR)/vms_cmds.ads $(ADA_GEN_SUBDIR)/gnat.help_in $(ADA_GEN_SUBDIR)/vms_data.ads
-- -$(MKDIR) $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp
-- $(RM) $(addprefix $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp/,$(notdir $^))
-- $(CP) $^ $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp
-- (cd $(ADA_GEN_SUBDIR)/bldtools/gnat_hlp; \
-- gnatmake -q vms_help; \
-- ./vms_help$(build_exeext) gnat.help_in vms_data.ads ../../gnat.hlp)
-diff --git a/gnat/ali-util.adb b/gnat/ali-util.adb
-index 98f79ba..40e2276 100644
---- a/gnat/ali-util.adb
-+++ b/gnat/ali-util.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -194,7 +194,7 @@ package body ALI.Util is
- -- This loop is empty and harmless the first time in.
-
- for J in Source.First .. Source.Last loop
-- Set_Name_Table_Info (Source.Table (J).Sfile, 0);
-+ Set_Name_Table_Int (Source.Table (J).Sfile, 0);
- Source.Table (J).Source_Found := False;
- end loop;
-
-@@ -236,7 +236,7 @@ package body ALI.Util is
- -- file has not been processed already.
-
- if Afile /= No_File
-- and then Get_Name_Table_Info (Afile) = 0
-+ and then Get_Name_Table_Int (Afile) = 0
- then
- Text := Read_Library_Info (Afile);
-
-@@ -251,7 +251,7 @@ package body ALI.Util is
- Error_Msg_File_1 := Afile;
- Error_Msg_File_2 := Withs.Table (W).Sfile;
- Error_Msg ("{ not found, { must be compiled");
-- Set_Name_Table_Info (Afile, Int (No_Unit_Id));
-+ Set_Name_Table_Int (Afile, Int (No_Unit_Id));
- return;
- end if;
-
-@@ -272,7 +272,7 @@ package body ALI.Util is
- then
- Error_Msg_File_1 := Withs.Table (W).Sfile;
- Error_Msg ("{ had errors, must be fixed, and recompiled");
-- Set_Name_Table_Info (Afile, Int (No_Unit_Id));
-+ Set_Name_Table_Int (Afile, Int (No_Unit_Id));
-
- -- In GNATprove mode, object files are never generated, so
- -- No_Object=True is not considered an error.
-@@ -283,7 +283,7 @@ package body ALI.Util is
- then
- Error_Msg_File_1 := Withs.Table (W).Sfile;
- Error_Msg ("{ must be recompiled");
-- Set_Name_Table_Info (Afile, Int (No_Unit_Id));
-+ Set_Name_Table_Int (Afile, Int (No_Unit_Id));
- end if;
-
- -- If the Unit is an Interface to a Stand-Alone Library,
-@@ -337,10 +337,10 @@ package body ALI.Util is
- -- If this is the first time we are seeing this source file,
- -- then make a new entry in the source table.
-
-- if Get_Name_Table_Info (F) = 0 then
-+ if Get_Name_Table_Int (F) = 0 then
- Source.Increment_Last;
- S := Source.Last;
-- Set_Name_Table_Info (F, Int (S));
-+ Set_Name_Table_Int (F, Int (S));
- Source.Table (S).Sfile := F;
- Source.Table (S).All_Timestamps_Match := True;
-
-@@ -393,7 +393,7 @@ package body ALI.Util is
- -- so that the source table entry is already constructed.
-
- else
-- S := Source_Id (Get_Name_Table_Info (F));
-+ S := Source_Id (Get_Name_Table_Int (F));
-
- -- Update checksum flag
-
-@@ -451,7 +451,7 @@ package body ALI.Util is
-
- -- Set the checksum value in the source table
-
-- S := Source_Id (Get_Name_Table_Info (F));
-+ S := Source_Id (Get_Name_Table_Int (F));
- Source.Table (S).Checksum := Sdep.Table (D).Checksum;
- end if;
-
-@@ -482,7 +482,7 @@ package body ALI.Util is
-
- begin
- for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
-- Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
-+ Src := Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile));
-
- if Opt.Minimal_Recompilation
- and then Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
-diff --git a/gnat/ali.adb b/gnat/ali.adb
-index d94cb7e..83bf2b9 100644
---- a/gnat/ali.adb
-+++ b/gnat/ali.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -72,11 +72,11 @@ package body ALI is
- -- These two loops are empty and harmless the first time in.
-
- for J in ALIs.First .. ALIs.Last loop
-- Set_Name_Table_Info (ALIs.Table (J).Afile, 0);
-+ Set_Name_Table_Int (ALIs.Table (J).Afile, 0);
- end loop;
-
- for J in Units.First .. Units.Last loop
-- Set_Name_Table_Info (Units.Table (J).Uname, 0);
-+ Set_Name_Table_Int (Units.Table (J).Uname, 0);
- end loop;
-
- -- Free argument table strings
-@@ -108,10 +108,10 @@ package body ALI is
- -- ALI files that are read for a given processing run in gnatbind.
-
- Dynamic_Elaboration_Checks_Specified := False;
-- Float_Format_Specified := ' ';
- Locking_Policy_Specified := ' ';
- No_Normalize_Scalars_Specified := False;
- No_Object_Specified := False;
-+ GNATprove_Mode_Specified := False;
- Normalize_Scalars_Specified := False;
- Partition_Elaboration_Policy_Specified := ' ';
- Queuing_Policy_Specified := ' ';
-@@ -867,7 +867,7 @@ package body ALI is
-
- ALIs.Increment_Last;
- Id := ALIs.Last;
-- Set_Name_Table_Info (F, Int (Id));
-+ Set_Name_Table_Int (F, Int (Id));
-
- ALIs.Table (Id) := (
- Afile => F,
-@@ -876,7 +876,7 @@ package body ALI is
- First_Sdep => No_Sdep_Id,
- First_Specific_Dispatching => Specific_Dispatching.Last + 1,
- First_Unit => No_Unit_Id,
-- Float_Format => 'I',
-+ GNATprove_Mode => False,
- Last_Interrupt_State => Interrupt_States.Last,
- Last_Sdep => No_Sdep_Id,
- Last_Specific_Dispatching => Specific_Dispatching.Last,
-@@ -1091,11 +1091,12 @@ package body ALI is
- ALIs.Table (Id).Partition_Elaboration_Policy :=
- Partition_Elaboration_Policy_Specified;
-
-- -- Processing for FD/FG/FI
-+ -- Processing for GP
-
-- elsif C = 'F' then
-- Float_Format_Specified := Getc;
-- ALIs.Table (Id).Float_Format := Float_Format_Specified;
-+ elsif C = 'G' then
-+ Checkc ('P');
-+ GNATprove_Mode_Specified := True;
-+ ALIs.Table (Id).GNATprove_Mode := True;
-
- -- Processing for Lx
-
-@@ -1703,6 +1704,7 @@ package body ALI is
- UL.Shared_Passive := False;
- UL.RCI := False;
- UL.Remote_Types := False;
-+ UL.Serious_Errors := False;
- UL.Has_RACW := False;
- UL.Init_Scalars := False;
- UL.Is_Generic := False;
-@@ -1736,7 +1738,7 @@ package body ALI is
- -- Check for duplicated unit in different files
-
- declare
-- Info : constant Int := Get_Name_Table_Info
-+ Info : constant Int := Get_Name_Table_Int
- (Units.Table (Units.Last).Uname);
- begin
- if Info /= 0
-@@ -1784,7 +1786,7 @@ package body ALI is
- end if;
- end;
-
-- Set_Name_Table_Info
-+ Set_Name_Table_Int
- (Units.Table (Units.Last).Uname, Int (Units.Last));
-
- -- Scan out possible version and other parameters
-@@ -1955,10 +1957,14 @@ package body ALI is
-
- Check_At_End_Of_Field;
-
-+ -- SE/SP/SU parameters
-+
- elsif C = 'S' then
- C := Getc;
-
-- if C = 'P' then
-+ if C = 'E' then
-+ Units.Table (Units.Last).Serious_Errors := True;
-+ elsif C = 'P' then
- Units.Table (Units.Last).Shared_Passive := True;
- elsif C = 'U' then
- Units.Table (Units.Last).Unit_Kind := 's';
-@@ -2185,20 +2191,30 @@ package body ALI is
- Notes.Table (Notes.Last).Pragma_Line := Get_Nat;
- Checkc (':');
- Notes.Table (Notes.Last).Pragma_Col := Get_Nat;
-- Notes.Table (Notes.Last).Unit := Units.Last;
-+
-+ if not At_Eol and then Nextc = ':' then
-+ Checkc (':');
-+ Notes.Table (Notes.Last).Pragma_Source_File :=
-+ Get_File_Name (Lower => True);
-+ else
-+ Notes.Table (Notes.Last).Pragma_Source_File :=
-+ Units.Table (Units.Last).Sfile;
-+ end if;
-
- if At_Eol then
- Notes.Table (Notes.Last).Pragma_Args := No_Name;
-
- else
-+ -- Note: can't use Get_Name here as the remainder of the
-+ -- line is unstructured text whose syntax depends on the
-+ -- particular pragma used.
-+
- Checkc (' ');
-
- Name_Len := 0;
- while not At_Eol loop
- Add_Char_To_Name_Buffer (Getc);
- end loop;
--
-- Notes.Table (Notes.Last).Pragma_Args := Name_Enter;
- end if;
-
- Skip_Eol;
-diff --git a/gnat/ali.ads b/gnat/ali.ads
-index 1b05ba6..8dc87bb 100644
---- a/gnat/ali.ads
-+++ b/gnat/ali.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -176,9 +176,10 @@ package ALI is
- -- always be set as well in this case. Not set if 'P' appears in
- -- Ignore_Lines.
-
-- Float_Format : Character;
-- -- Set to float format (set to I if no float-format given). Not set if
-- -- 'P' appears in Ignore_Lines.
-+ GNATprove_Mode : Boolean;
-+ -- Set to True if ALI and object file produced in GNATprove_Mode as
-+ -- signalled by GP appearing on the P line. Not set if 'P' appears in
-+ -- Ignore_Lines.
-
- No_Object : Boolean;
- -- Set to True if no object file generated. Not set if 'P' appears in
-@@ -301,6 +302,10 @@ package ALI is
- -- Indicates presence of RT parameter for a package which has a
- -- pragma Remote_Types.
-
-+ Serious_Errors : Boolean;
-+ -- Indicates presence of SE parameter indicating that compilation of
-+ -- the unit encountered as serious error.
-+
- Shared_Passive : Boolean;
- -- Indicates presence of SP parameter for a package which has a pragma
- -- Shared_Passive.
-@@ -469,10 +474,8 @@ package ALI is
- -- Set to False by Initialize_ALI. Set to True if Scan_ALI reads
- -- a unit for which dynamic elaboration checking is enabled.
-
-- Float_Format_Specified : Character := ' ';
-- -- Set to blank by Initialize_ALI. Set to appropriate float format
-- -- character (V or I, see Opt.Float_Format) if an ali file that
-- -- is read contains an F line setting the floating point format.
-+ GNATprove_Mode_Specified : Boolean := False;
-+ -- Set to True if an ali file was produced in GNATprove mode.
-
- Initialize_Scalars_Used : Boolean := False;
- -- Set True if an ali file contains the Initialize_Scalars flag
-@@ -669,8 +672,8 @@ package ALI is
- Pragma_Col : Nat;
- -- Column number of pragma
-
-- Unit : Unit_Id;
-- -- Unit_Id for the entry
-+ Pragma_Source_File : File_Name_Type;
-+ -- Source file of pragma
-
- Pragma_Args : Name_Id;
- -- Pragma arguments. No_Name if no arguments, otherwise a single
-diff --git a/gnat/alloc.ads b/gnat/alloc.ads
-index 6fa0147..e175f8b 100644
---- a/gnat/alloc.ads
-+++ b/gnat/alloc.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -64,14 +64,17 @@ package Alloc is
- File_Name_Chars_Initial : constant := 10_000; -- Osint
- File_Name_Chars_Increment : constant := 100;
-
-- Inlined_Bodies_Initial : constant := 50; -- Inline
-- Inlined_Bodies_Increment : constant := 200;
-+ In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
-+ In_Out_Warnings_Increment : constant := 100;
-+
-+ Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util
-+ Ignored_Ghost_Units_Increment : constant := 50;
-
- Inlined_Initial : constant := 100; -- Inline
- Inlined_Increment : constant := 100;
-
-- In_Out_Warnings_Initial : constant := 100; -- Sem_Warn
-- In_Out_Warnings_Increment : constant := 100;
-+ Inlined_Bodies_Initial : constant := 50; -- Inline
-+ Inlined_Bodies_Increment : constant := 200;
-
- Interp_Map_Initial : constant := 200; -- Sem_Type
- Interp_Map_Increment : constant := 100;
-diff --git a/gnat/aspects.adb b/gnat/aspects.adb
-index 1db2809..19e49b5 100644
---- a/gnat/aspects.adb
-+++ b/gnat/aspects.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -509,7 +509,9 @@ package body Aspects is
- Aspect_Convention => Aspect_Convention,
- Aspect_CPU => Aspect_CPU,
- Aspect_Default_Component_Value => Aspect_Default_Component_Value,
-+ Aspect_Default_Initial_Condition => Aspect_Default_Initial_Condition,
- Aspect_Default_Iterator => Aspect_Default_Iterator,
-+ Aspect_Default_Storage_Pool => Aspect_Default_Storage_Pool,
- Aspect_Default_Value => Aspect_Default_Value,
- Aspect_Depends => Aspect_Depends,
- Aspect_Dimension => Aspect_Dimension,
-@@ -521,9 +523,11 @@ package body Aspects is
- Aspect_Effective_Writes => Aspect_Effective_Writes,
- Aspect_Elaborate_Body => Aspect_Elaborate_Body,
- Aspect_Export => Aspect_Export,
-+ Aspect_Extensions_Visible => Aspect_Extensions_Visible,
- Aspect_External_Name => Aspect_External_Name,
- Aspect_External_Tag => Aspect_External_Tag,
- Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
-+ Aspect_Ghost => Aspect_Ghost,
- Aspect_Global => Aspect_Global,
- Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
- Aspect_Import => Aspect_Import,
-@@ -543,7 +547,10 @@ package body Aspects is
- Aspect_Linker_Section => Aspect_Linker_Section,
- Aspect_Lock_Free => Aspect_Lock_Free,
- Aspect_Machine_Radix => Aspect_Machine_Radix,
-+ Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All,
- Aspect_No_Return => Aspect_No_Return,
-+ Aspect_No_Tagged_Streams => Aspect_No_Tagged_Streams,
-+ Aspect_Obsolescent => Aspect_Obsolescent,
- Aspect_Object_Size => Aspect_Object_Size,
- Aspect_Output => Aspect_Output,
- Aspect_Pack => Aspect_Pack,
-@@ -582,6 +589,7 @@ package body Aspects is
- Aspect_Stream_Size => Aspect_Stream_Size,
- Aspect_Suppress => Aspect_Suppress,
- Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
-+ Aspect_Suppress_Initialization => Aspect_Suppress_Initialization,
- Aspect_Synchronization => Aspect_Synchronization,
- Aspect_Test_Case => Aspect_Test_Case,
- Aspect_Thread_Local_Storage => Aspect_Thread_Local_Storage,
-diff --git a/gnat/aspects.ads b/gnat/aspects.ads
-index 95e03d0..0e01beb 100644
---- a/gnat/aspects.ads
-+++ b/gnat/aspects.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -86,15 +86,19 @@ package Aspects is
- Aspect_Convention,
- Aspect_CPU,
- Aspect_Default_Component_Value,
-+ Aspect_Default_Initial_Condition, -- GNAT
- Aspect_Default_Iterator,
-+ Aspect_Default_Storage_Pool,
- Aspect_Default_Value,
- Aspect_Depends, -- GNAT
- Aspect_Dimension, -- GNAT
- Aspect_Dimension_System, -- GNAT
- Aspect_Dispatching_Domain,
- Aspect_Dynamic_Predicate,
-+ Aspect_Extensions_Visible, -- GNAT
- Aspect_External_Name,
- Aspect_External_Tag,
-+ Aspect_Ghost, -- GNAT
- Aspect_Global, -- GNAT
- Aspect_Implicit_Dereference,
- Aspect_Initial_Condition, -- GNAT
-@@ -108,6 +112,7 @@ package Aspects is
- Aspect_Linker_Section, -- GNAT
- Aspect_Machine_Radix,
- Aspect_Object_Size, -- GNAT
-+ Aspect_Obsolescent, -- GNAT
- Aspect_Output,
- Aspect_Part_Of, -- GNAT
- Aspect_Post,
-@@ -145,6 +150,7 @@ package Aspects is
-
- Aspect_All_Calls_Remote,
- Aspect_Elaborate_Body,
-+ Aspect_No_Elaboration_Code_All, -- GNAT
- Aspect_Preelaborate,
- Aspect_Pure,
- Aspect_Remote_Call_Interface,
-@@ -175,7 +181,9 @@ package Aspects is
- Aspect_Inline,
- Aspect_Inline_Always, -- GNAT
- Aspect_Interrupt_Handler,
-+ Aspect_Lock_Free, -- GNAT
- Aspect_No_Return,
-+ Aspect_No_Tagged_Streams, -- GNAT
- Aspect_Pack,
- Aspect_Persistent_BSS, -- GNAT
- Aspect_Preelaborable_Initialization,
-@@ -184,6 +192,7 @@ package Aspects is
- Aspect_Shared, -- GNAT (equivalent to Atomic)
- Aspect_Simple_Storage_Pool_Type, -- GNAT
- Aspect_Suppress_Debug_Info, -- GNAT
-+ Aspect_Suppress_Initialization, -- GNAT
- Aspect_Thread_Local_Storage, -- GNAT
- Aspect_Unchecked_Union,
- Aspect_Universal_Aliasing, -- GNAT
-@@ -191,12 +200,7 @@ package Aspects is
- Aspect_Unreferenced, -- GNAT
- Aspect_Unreferenced_Objects, -- GNAT
- Aspect_Volatile,
-- Aspect_Volatile_Components,
--
-- -- Aspects that have a static boolean value but don't correspond to
-- -- pragmas with a single argument that it is the entity in question.
--
-- Aspect_Lock_Free); -- GNAT
-+ Aspect_Volatile_Components);
-
- subtype Aspect_Id_Exclude_No_Aspect is
- Aspect_Id range Aspect_Id'Succ (No_Aspect) .. Aspect_Id'Last;
-@@ -229,7 +233,9 @@ package Aspects is
- Aspect_Dimension_System => True,
- Aspect_Effective_Reads => True,
- Aspect_Effective_Writes => True,
-+ Aspect_Extensions_Visible => True,
- Aspect_Favor_Top_Level => True,
-+ Aspect_Ghost => True,
- Aspect_Global => True,
- Aspect_Inline_Always => True,
- Aspect_Invariant => True,
-@@ -244,6 +250,7 @@ package Aspects is
- Aspect_Simple_Storage_Pool => True,
- Aspect_Simple_Storage_Pool_Type => True,
- Aspect_Suppress_Debug_Info => True,
-+ Aspect_Suppress_Initialization => True,
- Aspect_Thread_Local_Storage => True,
- Aspect_Test_Case => True,
- Aspect_Universal_Aliasing => True,
-@@ -295,76 +302,81 @@ package Aspects is
- -- The following array indicates what argument type is required
-
- Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression :=
-- (No_Aspect => Optional_Expression,
-- Aspect_Abstract_State => Expression,
-- Aspect_Address => Expression,
-- Aspect_Alignment => Expression,
-- Aspect_Annotate => Expression,
-- Aspect_Attach_Handler => Expression,
-- Aspect_Bit_Order => Expression,
-- Aspect_Component_Size => Expression,
-- Aspect_Constant_Indexing => Name,
-- Aspect_Contract_Cases => Expression,
-- Aspect_Convention => Name,
-- Aspect_CPU => Expression,
-- Aspect_Default_Component_Value => Expression,
-- Aspect_Default_Iterator => Name,
-- Aspect_Default_Value => Expression,
-- Aspect_Depends => Expression,
-- Aspect_Dimension => Expression,
-- Aspect_Dimension_System => Expression,
-- Aspect_Dispatching_Domain => Expression,
-- Aspect_Dynamic_Predicate => Expression,
-- Aspect_External_Name => Expression,
-- Aspect_External_Tag => Expression,
-- Aspect_Global => Expression,
-- Aspect_Implicit_Dereference => Name,
-- Aspect_Initial_Condition => Expression,
-- Aspect_Initializes => Expression,
-- Aspect_Input => Name,
-- Aspect_Interrupt_Priority => Expression,
-- Aspect_Invariant => Expression,
-- Aspect_Iterable => Expression,
-- Aspect_Iterator_Element => Name,
-- Aspect_Link_Name => Expression,
-- Aspect_Linker_Section => Expression,
-- Aspect_Machine_Radix => Expression,
-- Aspect_Object_Size => Expression,
-- Aspect_Output => Name,
-- Aspect_Part_Of => Expression,
-- Aspect_Post => Expression,
-- Aspect_Postcondition => Expression,
-- Aspect_Pre => Expression,
-- Aspect_Precondition => Expression,
-- Aspect_Predicate => Expression,
-- Aspect_Priority => Expression,
-- Aspect_Read => Name,
-- Aspect_Refined_Depends => Expression,
-- Aspect_Refined_Global => Expression,
-- Aspect_Refined_Post => Expression,
-- Aspect_Refined_State => Expression,
-- Aspect_Relative_Deadline => Expression,
-- Aspect_Scalar_Storage_Order => Expression,
-- Aspect_Simple_Storage_Pool => Name,
-- Aspect_Size => Expression,
-- Aspect_Small => Expression,
-- Aspect_SPARK_Mode => Optional_Name,
-- Aspect_Static_Predicate => Expression,
-- Aspect_Storage_Pool => Name,
-- Aspect_Storage_Size => Expression,
-- Aspect_Stream_Size => Expression,
-- Aspect_Suppress => Name,
-- Aspect_Synchronization => Name,
-- Aspect_Test_Case => Expression,
-- Aspect_Type_Invariant => Expression,
-- Aspect_Unsuppress => Name,
-- Aspect_Value_Size => Expression,
-- Aspect_Variable_Indexing => Name,
-- Aspect_Warnings => Name,
-- Aspect_Write => Name,
--
-- Boolean_Aspects => Optional_Expression,
-- Library_Unit_Aspects => Optional_Expression);
-+ (No_Aspect => Optional_Expression,
-+ Aspect_Abstract_State => Expression,
-+ Aspect_Address => Expression,
-+ Aspect_Alignment => Expression,
-+ Aspect_Annotate => Expression,
-+ Aspect_Attach_Handler => Expression,
-+ Aspect_Bit_Order => Expression,
-+ Aspect_Component_Size => Expression,
-+ Aspect_Constant_Indexing => Name,
-+ Aspect_Contract_Cases => Expression,
-+ Aspect_Convention => Name,
-+ Aspect_CPU => Expression,
-+ Aspect_Default_Component_Value => Expression,
-+ Aspect_Default_Initial_Condition => Optional_Expression,
-+ Aspect_Default_Iterator => Name,
-+ Aspect_Default_Storage_Pool => Expression,
-+ Aspect_Default_Value => Expression,
-+ Aspect_Depends => Expression,
-+ Aspect_Dimension => Expression,
-+ Aspect_Dimension_System => Expression,
-+ Aspect_Dispatching_Domain => Expression,
-+ Aspect_Dynamic_Predicate => Expression,
-+ Aspect_Extensions_Visible => Optional_Expression,
-+ Aspect_External_Name => Expression,
-+ Aspect_External_Tag => Expression,
-+ Aspect_Ghost => Optional_Expression,
-+ Aspect_Global => Expression,
-+ Aspect_Implicit_Dereference => Name,
-+ Aspect_Initial_Condition => Expression,
-+ Aspect_Initializes => Expression,
-+ Aspect_Input => Name,
-+ Aspect_Interrupt_Priority => Expression,
-+ Aspect_Invariant => Expression,
-+ Aspect_Iterable => Expression,
-+ Aspect_Iterator_Element => Name,
-+ Aspect_Link_Name => Expression,
-+ Aspect_Linker_Section => Expression,
-+ Aspect_Machine_Radix => Expression,
-+ Aspect_Object_Size => Expression,
-+ Aspect_Obsolescent => Optional_Expression,
-+ Aspect_Output => Name,
-+ Aspect_Part_Of => Expression,
-+ Aspect_Post => Expression,
-+ Aspect_Postcondition => Expression,
-+ Aspect_Pre => Expression,
-+ Aspect_Precondition => Expression,
-+ Aspect_Predicate => Expression,
-+ Aspect_Priority => Expression,
-+ Aspect_Read => Name,
-+ Aspect_Refined_Depends => Expression,
-+ Aspect_Refined_Global => Expression,
-+ Aspect_Refined_Post => Expression,
-+ Aspect_Refined_State => Expression,
-+ Aspect_Relative_Deadline => Expression,
-+ Aspect_Scalar_Storage_Order => Expression,
-+ Aspect_Simple_Storage_Pool => Name,
-+ Aspect_Size => Expression,
-+ Aspect_Small => Expression,
-+ Aspect_SPARK_Mode => Optional_Name,
-+ Aspect_Static_Predicate => Expression,
-+ Aspect_Storage_Pool => Name,
-+ Aspect_Storage_Size => Expression,
-+ Aspect_Stream_Size => Expression,
-+ Aspect_Suppress => Name,
-+ Aspect_Synchronization => Name,
-+ Aspect_Test_Case => Expression,
-+ Aspect_Type_Invariant => Expression,
-+ Aspect_Unsuppress => Name,
-+ Aspect_Value_Size => Expression,
-+ Aspect_Variable_Indexing => Name,
-+ Aspect_Warnings => Name,
-+ Aspect_Write => Name,
-+
-+ Boolean_Aspects => Optional_Expression,
-+ Library_Unit_Aspects => Optional_Expression);
-
- -----------------------------------------
- -- Table Linking Names and Aspect_Id's --
-@@ -391,9 +403,11 @@ package Aspects is
- Aspect_Contract_Cases => Name_Contract_Cases,
- Aspect_Convention => Name_Convention,
- Aspect_CPU => Name_CPU,
-+ Aspect_Default_Component_Value => Name_Default_Component_Value,
-+ Aspect_Default_Initial_Condition => Name_Default_Initial_Condition,
- Aspect_Default_Iterator => Name_Default_Iterator,
-+ Aspect_Default_Storage_Pool => Name_Default_Storage_Pool,
- Aspect_Default_Value => Name_Default_Value,
-- Aspect_Default_Component_Value => Name_Default_Component_Value,
- Aspect_Depends => Name_Depends,
- Aspect_Dimension => Name_Dimension,
- Aspect_Dimension_System => Name_Dimension_System,
-@@ -403,10 +417,12 @@ package Aspects is
- Aspect_Effective_Reads => Name_Effective_Reads,
- Aspect_Effective_Writes => Name_Effective_Writes,
- Aspect_Elaborate_Body => Name_Elaborate_Body,
-+ Aspect_Export => Name_Export,
-+ Aspect_Extensions_Visible => Name_Extensions_Visible,
- Aspect_External_Name => Name_External_Name,
- Aspect_External_Tag => Name_External_Tag,
-- Aspect_Export => Name_Export,
- Aspect_Favor_Top_Level => Name_Favor_Top_Level,
-+ Aspect_Ghost => Name_Ghost,
- Aspect_Global => Name_Global,
- Aspect_Implicit_Dereference => Name_Implicit_Dereference,
- Aspect_Import => Name_Import,
-@@ -426,8 +442,11 @@ package Aspects is
- Aspect_Linker_Section => Name_Linker_Section,
- Aspect_Lock_Free => Name_Lock_Free,
- Aspect_Machine_Radix => Name_Machine_Radix,
-+ Aspect_No_Elaboration_Code_All => Name_No_Elaboration_Code_All,
- Aspect_No_Return => Name_No_Return,
-+ Aspect_No_Tagged_Streams => Name_No_Tagged_Streams,
- Aspect_Object_Size => Name_Object_Size,
-+ Aspect_Obsolescent => Name_Obsolescent,
- Aspect_Output => Name_Output,
- Aspect_Pack => Name_Pack,
- Aspect_Part_Of => Name_Part_Of,
-@@ -465,6 +484,7 @@ package Aspects is
- Aspect_Stream_Size => Name_Stream_Size,
- Aspect_Suppress => Name_Suppress,
- Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info,
-+ Aspect_Suppress_Initialization => Name_Suppress_Initialization,
- Aspect_Thread_Local_Storage => Name_Thread_Local_Storage,
- Aspect_Synchronization => Name_Synchronization,
- Aspect_Test_Case => Name_Test_Case,
-@@ -543,6 +563,14 @@ package Aspects is
- -- information from the parent type, which must be frozen at that point
- -- (since freezing the derived type first freezes the parent type).
-
-+ -- SPARK 2014 aspects do not follow the general delay mechanism as they
-+ -- act as annotations and cannot modify the attributes of their related
-+ -- constructs. To handle forward references in such aspects, the compiler
-+ -- delays the analysis of their respective pragmas by collecting them in
-+ -- N_Contract nodes. The pragmas are then analyzed at the end of the
-+ -- declarative region which contains the related construct. For details,
-+ -- see routines Analyze_xxx_In_Decl_Part.
-+
- -- The following shows which aspects are delayed. There are three cases:
-
- type Delay_Type is
-@@ -590,36 +618,28 @@ package Aspects is
- (No_Aspect => Always_Delay,
- Aspect_Address => Always_Delay,
- Aspect_All_Calls_Remote => Always_Delay,
-- Aspect_Async_Readers => Always_Delay,
-- Aspect_Async_Writers => Always_Delay,
- Aspect_Asynchronous => Always_Delay,
- Aspect_Attach_Handler => Always_Delay,
- Aspect_Constant_Indexing => Always_Delay,
-- Aspect_Contract_Cases => Always_Delay,
- Aspect_CPU => Always_Delay,
- Aspect_Default_Iterator => Always_Delay,
-+ Aspect_Default_Storage_Pool => Always_Delay,
- Aspect_Default_Value => Always_Delay,
- Aspect_Default_Component_Value => Always_Delay,
-- Aspect_Depends => Always_Delay,
- Aspect_Discard_Names => Always_Delay,
- Aspect_Dispatching_Domain => Always_Delay,
- Aspect_Dynamic_Predicate => Always_Delay,
-- Aspect_Effective_Reads => Always_Delay,
-- Aspect_Effective_Writes => Always_Delay,
- Aspect_Elaborate_Body => Always_Delay,
-+ Aspect_Export => Always_Delay,
- Aspect_External_Name => Always_Delay,
- Aspect_External_Tag => Always_Delay,
-- Aspect_Export => Always_Delay,
- Aspect_Favor_Top_Level => Always_Delay,
-- Aspect_Global => Always_Delay,
- Aspect_Implicit_Dereference => Always_Delay,
- Aspect_Import => Always_Delay,
- Aspect_Independent => Always_Delay,
- Aspect_Independent_Components => Always_Delay,
- Aspect_Inline => Always_Delay,
- Aspect_Inline_Always => Always_Delay,
-- Aspect_Initial_Condition => Always_Delay,
-- Aspect_Initializes => Always_Delay,
- Aspect_Input => Always_Delay,
- Aspect_Interrupt_Handler => Always_Delay,
- Aspect_Interrupt_Priority => Always_Delay,
-@@ -643,9 +663,6 @@ package Aspects is
- Aspect_Pure => Always_Delay,
- Aspect_Pure_Function => Always_Delay,
- Aspect_Read => Always_Delay,
-- Aspect_Refined_Depends => Always_Delay,
-- Aspect_Refined_Global => Always_Delay,
-- Aspect_Refined_State => Always_Delay,
- Aspect_Relative_Deadline => Always_Delay,
- Aspect_Remote_Access_Type => Always_Delay,
- Aspect_Remote_Call_Interface => Always_Delay,
-@@ -659,6 +676,7 @@ package Aspects is
- Aspect_Stream_Size => Always_Delay,
- Aspect_Suppress => Always_Delay,
- Aspect_Suppress_Debug_Info => Always_Delay,
-+ Aspect_Suppress_Initialization => Always_Delay,
- Aspect_Thread_Local_Storage => Always_Delay,
- Aspect_Type_Invariant => Always_Delay,
- Aspect_Unchecked_Union => Always_Delay,
-@@ -673,11 +691,29 @@ package Aspects is
-
- Aspect_Abstract_State => Never_Delay,
- Aspect_Annotate => Never_Delay,
-+ Aspect_Async_Readers => Never_Delay,
-+ Aspect_Async_Writers => Never_Delay,
-+ Aspect_Contract_Cases => Never_Delay,
- Aspect_Convention => Never_Delay,
-+ Aspect_Default_Initial_Condition => Never_Delay,
-+ Aspect_Depends => Never_Delay,
- Aspect_Dimension => Never_Delay,
- Aspect_Dimension_System => Never_Delay,
-+ Aspect_Effective_Reads => Never_Delay,
-+ Aspect_Effective_Writes => Never_Delay,
-+ Aspect_Extensions_Visible => Never_Delay,
-+ Aspect_Ghost => Never_Delay,
-+ Aspect_Global => Never_Delay,
-+ Aspect_Initial_Condition => Never_Delay,
-+ Aspect_Initializes => Never_Delay,
-+ Aspect_No_Elaboration_Code_All => Never_Delay,
-+ Aspect_No_Tagged_Streams => Never_Delay,
-+ Aspect_Obsolescent => Never_Delay,
- Aspect_Part_Of => Never_Delay,
-+ Aspect_Refined_Depends => Never_Delay,
-+ Aspect_Refined_Global => Never_Delay,
- Aspect_Refined_Post => Never_Delay,
-+ Aspect_Refined_State => Never_Delay,
- Aspect_SPARK_Mode => Never_Delay,
- Aspect_Synchronization => Never_Delay,
- Aspect_Test_Case => Never_Delay,
-diff --git a/gnat/atree.adb b/gnat/atree.adb
-index 6de5368..3264ac3 100644
---- a/gnat/atree.adb
-+++ b/gnat/atree.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -39,6 +39,7 @@ pragma Style_Checks (All_Checks);
- with Aspects; use Aspects;
- with Debug; use Debug;
- with Nlists; use Nlists;
-+with Opt; use Opt;
- with Output; use Output;
- with Sinput; use Sinput;
- with Tree_IO; use Tree_IO;
-@@ -569,10 +570,10 @@ package body Atree is
- then
- New_Id := Src;
-
-- else
-- -- We are allocating a new node, or extending a node
-- -- other than Nodes.Last.
-+ -- We are allocating a new node, or extending a node other than
-+ -- Nodes.Last.
-
-+ else
- if Present (Src) then
- Nodes.Append (Nodes.Table (Src));
- Flags.Append (Flags.Table (Src));
-@@ -586,6 +587,13 @@ package body Atree is
- Node_Count := Node_Count + 1;
- end if;
-
-+ -- Mark the node as ignored Ghost if it is created in an ignored Ghost
-+ -- region.
-+
-+ if Ghost_Mode = Ignore then
-+ Set_Is_Ignored_Ghost_Node (New_Id);
-+ end if;
-+
- -- Specifically copy Paren_Count to deal with creating new table entry
- -- if the parentheses count is at the maximum possible value already.
-
-@@ -892,6 +900,16 @@ package body Atree is
- Set_Field4 (New_Id, Possible_Copy (Field4 (New_Id)));
- Set_Field5 (New_Id, Possible_Copy (Field5 (New_Id)));
-
-+ -- Explicitly copy the aspect specifications as those do not reside
-+ -- in a node field.
-+
-+ if Permits_Aspect_Specifications (Source)
-+ and then Has_Aspects (Source)
-+ then
-+ Set_Aspect_Specifications
-+ (New_Id, Copy_List (Aspect_Specifications (Source)));
-+ end if;
-+
- -- Set Entity field to Empty to ensure that no entity references
- -- are shared between the two, if the source is already analyzed.
-
-@@ -1070,6 +1088,30 @@ package body Atree is
- end Ekind_In;
-
- function Ekind_In
-+ (T : Entity_Kind;
-+ V1 : Entity_Kind;
-+ V2 : Entity_Kind;
-+ V3 : Entity_Kind;
-+ V4 : Entity_Kind;
-+ V5 : Entity_Kind;
-+ V6 : Entity_Kind;
-+ V7 : Entity_Kind;
-+ V8 : Entity_Kind;
-+ V9 : Entity_Kind) return Boolean
-+ is
-+ begin
-+ return T = V1 or else
-+ T = V2 or else
-+ T = V3 or else
-+ T = V4 or else
-+ T = V5 or else
-+ T = V6 or else
-+ T = V7 or else
-+ T = V8 or else
-+ T = V9;
-+ end Ekind_In;
-+
-+ function Ekind_In
- (E : Entity_Id;
- V1 : Entity_Kind;
- V2 : Entity_Kind) return Boolean
-@@ -1153,6 +1195,22 @@ package body Atree is
- return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6, V7, V8);
- end Ekind_In;
-
-+ function Ekind_In
-+ (E : Entity_Id;
-+ V1 : Entity_Kind;
-+ V2 : Entity_Kind;
-+ V3 : Entity_Kind;
-+ V4 : Entity_Kind;
-+ V5 : Entity_Kind;
-+ V6 : Entity_Kind;
-+ V7 : Entity_Kind;
-+ V8 : Entity_Kind;
-+ V9 : Entity_Kind) return Boolean
-+ is
-+ begin
-+ return Ekind_In (Ekind (E), V1, V2, V3, V4, V5, V6, V7, V8, V9);
-+ end Ekind_In;
-+
- ------------------------
- -- Set_Reporting_Proc --
- ------------------------
-@@ -1372,6 +1430,15 @@ package body Atree is
- Set_Error_Posted (Error, True);
- end Initialize;
-
-+ ---------------------------
-+ -- Is_Ignored_Ghost_Node --
-+ ---------------------------
-+
-+ function Is_Ignored_Ghost_Node (N : Node_Id) return Boolean is
-+ begin
-+ return Flags.Table (N).Is_Ignored_Ghost_Node;
-+ end Is_Ignored_Ghost_Node;
-+
- --------------------------
- -- Is_Rewrite_Insertion --
- --------------------------
-@@ -1800,18 +1867,17 @@ package body Atree is
- New_Node := New_Copy (Source);
- Fix_Parents (Ref_Node => Source, Fix_Node => New_Node);
-
-- -- We now set the parent of the new node to be the same as the
-- -- parent of the source. Almost always this parent will be
-- -- replaced by a new value when the relocated node is reattached
-- -- to the tree, but by doing it now, we ensure that this node is
-- -- not even temporarily disconnected from the tree. Note that this
-- -- does not happen free, because in the list case, the parent does
-- -- not get set.
-+ -- We now set the parent of the new node to be the same as the parent of
-+ -- the source. Almost always this parent will be replaced by a new value
-+ -- when the relocated node is reattached to the tree, but by doing it
-+ -- now, we ensure that this node is not even temporarily disconnected
-+ -- from the tree. Note that this does not happen free, because in the
-+ -- list case, the parent does not get set.
-
- Set_Parent (New_Node, Parent (Source));
-
-- -- If the node being relocated was a rewriting of some original
-- -- node, then the relocated node has the same original node.
-+ -- If the node being relocated was a rewriting of some original node,
-+ -- then the relocated node has the same original node.
-
- if Orig_Nodes.Table (Source) /= Source then
- Orig_Nodes.Table (New_Node) := Orig_Nodes.Table (Source);
-@@ -2022,6 +2088,15 @@ package body Atree is
- Nodes.Table (N).Has_Aspects := Val;
- end Set_Has_Aspects;
-
-+ -------------------------------
-+ -- Set_Is_Ignored_Ghost_Node --
-+ -------------------------------
-+
-+ procedure Set_Is_Ignored_Ghost_Node (N : Node_Id; Val : Boolean := True) is
-+ begin
-+ Flags.Table (N).Is_Ignored_Ghost_Node := Val;
-+ end Set_Is_Ignored_Ghost_Node;
-+
- -----------------------
- -- Set_Original_Node --
- -----------------------
-diff --git a/gnat/atree.ads b/gnat/atree.ads
-index 113a36b..7d2e64f 100644
---- a/gnat/atree.ads
-+++ b/gnat/atree.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -313,7 +313,16 @@ package Atree is
-
- Warnings_Detected : Nat := 0;
- -- Number of warnings detected. Initialized to zero at the start of
-- -- compilation. Initialized for -gnatVa use, see comment above.
-+ -- compilation. Initialized for -gnatVa use, see comment above. This
-+ -- count includes the count of style and info messages.
-+
-+ Info_Messages : Nat := 0;
-+ -- Number of info messages generated. Info messages are neved treated as
-+ -- errors (whether from use of the pragma, or the compiler switch -gnatwe).
-+
-+ Check_Messages : Nat := 0;
-+ -- Number of check messages generated. Check messages are neither warnings
-+ -- nor errors.
-
- Warnings_Treated_As_Errors : Nat := 0;
- -- Number of warnings changed into errors as a result of matching a pattern
-@@ -596,42 +605,46 @@ package Atree is
- -- The following functions return the contents of the indicated field of
- -- the node referenced by the argument, which is a Node_Id.
-
-- function Nkind (N : Node_Id) return Node_Kind;
-- pragma Inline (Nkind);
--
- function Analyzed (N : Node_Id) return Boolean;
- pragma Inline (Analyzed);
-
-- function Has_Aspects (N : Node_Id) return Boolean;
-- pragma Inline (Has_Aspects);
--
- function Comes_From_Source (N : Node_Id) return Boolean;
- pragma Inline (Comes_From_Source);
-
- function Error_Posted (N : Node_Id) return Boolean;
- pragma Inline (Error_Posted);
-
-- function Sloc (N : Node_Id) return Source_Ptr;
-- pragma Inline (Sloc);
-+ function Has_Aspects (N : Node_Id) return Boolean;
-+ pragma Inline (Has_Aspects);
-
-- function Paren_Count (N : Node_Id) return Nat;
-- pragma Inline (Paren_Count);
-+ function Is_Ignored_Ghost_Node
-+ (N : Node_Id) return Boolean;
-+ pragma Inline (Is_Ignored_Ghost_Node);
-
-- function Parent (N : Node_Id) return Node_Id;
-- pragma Inline (Parent);
-- -- Returns the parent of a node if the node is not a list member, or else
-- -- the parent of the list containing the node if the node is a list member.
-+ function Nkind (N : Node_Id) return Node_Kind;
-+ pragma Inline (Nkind);
-
- function No (N : Node_Id) return Boolean;
- pragma Inline (No);
- -- Tests given Id for equality with the Empty node. This allows notations
- -- like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty".
-
-+ function Parent (N : Node_Id) return Node_Id;
-+ pragma Inline (Parent);
-+ -- Returns the parent of a node if the node is not a list member, or else
-+ -- the parent of the list containing the node if the node is a list member.
-+
-+ function Paren_Count (N : Node_Id) return Nat;
-+ pragma Inline (Paren_Count);
-+
- function Present (N : Node_Id) return Boolean;
- pragma Inline (Present);
- -- Tests given Id for inequality with the Empty node. This allows notations
- -- like "if Present (Statement)" as opposed to "if Statement /= Empty".
-
-+ function Sloc (N : Node_Id) return Source_Ptr;
-+ pragma Inline (Sloc);
-+
- ---------------------
- -- Node_Kind Tests --
- ---------------------
-@@ -776,6 +789,18 @@ package Atree is
- V8 : Entity_Kind) return Boolean;
-
- function Ekind_In
-+ (E : Entity_Id;
-+ V1 : Entity_Kind;
-+ V2 : Entity_Kind;
-+ V3 : Entity_Kind;
-+ V4 : Entity_Kind;
-+ V5 : Entity_Kind;
-+ V6 : Entity_Kind;
-+ V7 : Entity_Kind;
-+ V8 : Entity_Kind;
-+ V9 : Entity_Kind) return Boolean;
-+
-+ function Ekind_In
- (T : Entity_Kind;
- V1 : Entity_Kind;
- V2 : Entity_Kind) return Boolean;
-@@ -831,6 +856,18 @@ package Atree is
- V7 : Entity_Kind;
- V8 : Entity_Kind) return Boolean;
-
-+ function Ekind_In
-+ (T : Entity_Kind;
-+ V1 : Entity_Kind;
-+ V2 : Entity_Kind;
-+ V3 : Entity_Kind;
-+ V4 : Entity_Kind;
-+ V5 : Entity_Kind;
-+ V6 : Entity_Kind;
-+ V7 : Entity_Kind;
-+ V8 : Entity_Kind;
-+ V9 : Entity_Kind) return Boolean;
-+
- pragma Inline (Ekind_In);
- -- Inline all above functions
-
-@@ -856,39 +893,42 @@ package Atree is
- -- to be set in the specified field. Note that Set_Nkind is in the next
- -- section, since its use is restricted.
-
-- procedure Set_Sloc (N : Node_Id; Val : Source_Ptr);
-- pragma Inline (Set_Sloc);
--
-- procedure Set_Paren_Count (N : Node_Id; Val : Nat);
-- pragma Inline (Set_Paren_Count);
--
-- procedure Set_Parent (N : Node_Id; Val : Node_Id);
-- pragma Inline (Set_Parent);
--
-- procedure Set_Analyzed (N : Node_Id; Val : Boolean := True);
-+ procedure Set_Analyzed (N : Node_Id; Val : Boolean := True);
- pragma Inline (Set_Analyzed);
-
-- procedure Set_Error_Posted (N : Node_Id; Val : Boolean := True);
-- pragma Inline (Set_Error_Posted);
--
- procedure Set_Comes_From_Source (N : Node_Id; Val : Boolean);
- pragma Inline (Set_Comes_From_Source);
-- -- Note that this routine is very rarely used, since usually the
-- -- default mechanism provided sets the right value, but in some
-- -- unusual cases, the value needs to be reset (e.g. when a source
-- -- node is copied, and the copy must not have Comes_From_Source set).
-+ -- Note that this routine is very rarely used, since usually the default
-+ -- mechanism provided sets the right value, but in some unusual cases, the
-+ -- value needs to be reset (e.g. when a source node is copied, and the copy
-+ -- must not have Comes_From_Source set).
-+
-+ procedure Set_Error_Posted (N : Node_Id; Val : Boolean := True);
-+ pragma Inline (Set_Error_Posted);
-
- procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True);
- pragma Inline (Set_Has_Aspects);
-
-+ procedure Set_Is_Ignored_Ghost_Node (N : Node_Id; Val : Boolean := True);
-+ pragma Inline (Set_Is_Ignored_Ghost_Node);
-+
- procedure Set_Original_Node (N : Node_Id; Val : Node_Id);
- pragma Inline (Set_Original_Node);
- -- Note that this routine is used only in very peculiar cases. In normal
- -- cases, the Original_Node link is set by calls to Rewrite. We currently
-- -- use it in ASIS mode to manually set the link from pragma expressions
-- -- to their aspect original source expressions, so that the original source
-+ -- use it in ASIS mode to manually set the link from pragma expressions to
-+ -- their aspect original source expressions, so that the original source
- -- expressions accessed by ASIS are also semantically analyzed.
-
-+ procedure Set_Parent (N : Node_Id; Val : Node_Id);
-+ pragma Inline (Set_Parent);
-+
-+ procedure Set_Paren_Count (N : Node_Id; Val : Nat);
-+ pragma Inline (Set_Paren_Count);
-+
-+ procedure Set_Sloc (N : Node_Id; Val : Source_Ptr);
-+ pragma Inline (Set_Sloc);
-+
- ------------------------------
- -- Entity Update Procedures --
- ------------------------------
-@@ -3998,7 +4038,12 @@ package Atree is
- Flag1 : Boolean;
- Flag2 : Boolean;
- Flag3 : Boolean;
-- Spare0 : Boolean;
-+
-+ Is_Ignored_Ghost_Node : Boolean;
-+ -- Flag denothing whether the node is subject to pragma Ghost with
-+ -- policy Ignore. The name of the flag should be Flag4, however this
-+ -- requires changing the names of all remaining 300+ flags.
-+
- Spare1 : Boolean;
- Spare2 : Boolean;
- Spare3 : Boolean;
-diff --git a/gnat/binderr.ads b/gnat/binderr.ads
-index 3a419d5..46b1846 100644
---- a/gnat/binderr.ads
-+++ b/gnat/binderr.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -59,7 +59,7 @@ package Binderr is
- -- specified by the File_Name_Type value stored in Error_Msg_File_2.
-
- -- Insertion character $ (Dollar: insert unit name from Names table)
-- -- The character & is replaced by the text for the unit name specified
-+ -- The character $ is replaced by the text for the unit name specified
- -- by the Name_Id value stored in Error_Msg_Unit_1. The name is always
- -- enclosed in quotes. A second $ may appear in a single message in
- -- which case it is similarly replaced by the name which is specified
-diff --git a/gnat/butil.adb b/gnat/butil.adb
-index 703d243..3ac112a 100644
---- a/gnat/butil.adb
-+++ b/gnat/butil.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -23,8 +23,7 @@
- -- --
- ------------------------------------------------------------------------------
-
--with Output; use Output;
--with Targparm; use Targparm;
-+with Output; use Output;
-
- package body Butil is
-
-@@ -38,17 +37,9 @@ package body Butil is
- function Is_Internal_Unit return Boolean is
- begin
- return Is_Predefined_Unit
-- or else (Name_Len > 4
-- and then (Name_Buffer (1 .. 5) = "gnat%"
-- or else
-- Name_Buffer (1 .. 5) = "gnat."))
-- or else
-- (OpenVMS_On_Target
-- and then Name_Len > 3
-- and then (Name_Buffer (1 .. 4) = "dec%"
-- or else
-- Name_Buffer (1 .. 4) = "dec."));
--
-+ or else (Name_Len > 4 and then (Name_Buffer (1 .. 5) = "gnat%"
-+ or else
-+ Name_Buffer (1 .. 5) = "gnat."));
- end Is_Internal_Unit;
-
- ------------------------
-@@ -59,54 +50,25 @@ package body Butil is
- -- is that it would drag too much junk into the binder.
-
- function Is_Predefined_Unit return Boolean is
-+ L : Natural renames Name_Len;
-+ B : String renames Name_Buffer;
- begin
-- return (Name_Len > 3
-- and then Name_Buffer (1 .. 4) = "ada.")
--
-- or else (Name_Len > 6
-- and then Name_Buffer (1 .. 7) = "system.")
--
-- or else (Name_Len > 10
-- and then Name_Buffer (1 .. 11) = "interfaces.")
--
-- or else (Name_Len > 3
-- and then Name_Buffer (1 .. 4) = "ada%")
--
-- or else (Name_Len > 8
-- and then Name_Buffer (1 .. 9) = "calendar%")
--
-- or else (Name_Len > 9
-- and then Name_Buffer (1 .. 10) = "direct_io%")
--
-- or else (Name_Len > 10
-- and then Name_Buffer (1 .. 11) = "interfaces%")
--
-- or else (Name_Len > 13
-- and then Name_Buffer (1 .. 14) = "io_exceptions%")
--
-- or else (Name_Len > 12
-- and then Name_Buffer (1 .. 13) = "machine_code%")
--
-- or else (Name_Len > 13
-- and then Name_Buffer (1 .. 14) = "sequential_io%")
--
-- or else (Name_Len > 6
-- and then Name_Buffer (1 .. 7) = "system%")
--
-- or else (Name_Len > 7
-- and then Name_Buffer (1 .. 8) = "text_io%")
--
-- or else (Name_Len > 20
-- and then Name_Buffer (1 .. 21) = "unchecked_conversion%")
--
-- or else (Name_Len > 22
-- and then Name_Buffer (1 .. 23) = "unchecked_deallocation%")
--
-- or else (Name_Len > 4
-- and then Name_Buffer (1 .. 5) = "gnat%")
--
-- or else (Name_Len > 4
-- and then Name_Buffer (1 .. 5) = "gnat.");
-+ return (L > 3 and then B (1 .. 4) = "ada.")
-+ or else (L > 6 and then B (1 .. 7) = "system.")
-+ or else (L > 10 and then B (1 .. 11) = "interfaces.")
-+ or else (L > 3 and then B (1 .. 4) = "ada%")
-+ or else (L > 8 and then B (1 .. 9) = "calendar%")
-+ or else (L > 9 and then B (1 .. 10) = "direct_io%")
-+ or else (L > 10 and then B (1 .. 11) = "interfaces%")
-+ or else (L > 13 and then B (1 .. 14) = "io_exceptions%")
-+ or else (L > 12 and then B (1 .. 13) = "machine_code%")
-+ or else (L > 13 and then B (1 .. 14) = "sequential_io%")
-+ or else (L > 6 and then B (1 .. 7) = "system%")
-+ or else (L > 7 and then B (1 .. 8) = "text_io%")
-+ or else (L > 20 and then B (1 .. 21) = "unchecked_conversion%")
-+ or else (L > 22 and then B (1 .. 23) = "unchecked_deallocation%")
-+ or else (L > 4 and then B (1 .. 5) = "gnat%")
-+ or else (L > 4 and then B (1 .. 5) = "gnat.");
- end Is_Predefined_Unit;
-
- ----------------
-@@ -119,7 +81,7 @@ package body Butil is
-
- declare
- U1_Name : constant String (1 .. Name_Len) :=
-- Name_Buffer (1 .. Name_Len);
-+ Name_Buffer (1 .. Name_Len);
- Min_Length : Natural;
-
- begin
-@@ -131,10 +93,10 @@ package body Butil is
- Min_Length := U1_Name'Last;
- end if;
-
-- for I in 1 .. Min_Length loop
-- if U1_Name (I) > Name_Buffer (I) then
-+ for J in 1 .. Min_Length loop
-+ if U1_Name (J) > Name_Buffer (J) then
- return False;
-- elsif U1_Name (I) < Name_Buffer (I) then
-+ elsif U1_Name (J) < Name_Buffer (J) then
- return True;
- end if;
- end loop;
-diff --git a/gnat/butil.ads b/gnat/butil.ads
-index 72fffc0..ddfa251 100644
---- a/gnat/butil.ads
-+++ b/gnat/butil.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -38,7 +38,7 @@ package Butil is
- function Is_Internal_Unit return Boolean;
- -- Given a unit name stored in Name_Buffer with length in Name_Len,
- -- returns True if this is the name of an internal unit or a child of
-- -- an internal. Similar in usage to Is_Predefined_Unit.
-+ -- an internal unit. Similar in usage to Is_Predefined_Unit.
-
- -- Note: the following functions duplicate functionality in Uname, but
- -- we want to avoid bringing Uname into the binder since it generates
-diff --git a/gnat/casing.adb b/gnat/casing.adb
-index c91e6b7..5ed97be 100644
---- a/gnat/casing.adb
-+++ b/gnat/casing.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/casing.ads b/gnat/casing.ads
-index 7a0e28f..dec27ee 100644
---- a/gnat/casing.ads
-+++ b/gnat/casing.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/csets.adb b/gnat/csets.adb
-index de84329..97b21fa 100644
---- a/gnat/csets.adb
-+++ b/gnat/csets.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/csets.ads b/gnat/csets.ads
-index 18cbb40..bae2347 100644
---- a/gnat/csets.ads
-+++ b/gnat/csets.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/debug.adb b/gnat/debug.adb
-index 401f350..31c3972 100644
---- a/gnat/debug.adb
-+++ b/gnat/debug.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -49,7 +49,7 @@ package body Debug is
- -- dj Suppress "junk null check" for access parameter values
- -- dk Generate GNATBUG message on abort, even if previous errors
- -- dl Generate unit load trace messages
-- -- dm Allow VMS features even if not OpenVMS version
-+ -- dm
- -- dn Generate messages for node/list allocation
- -- do Print source from tree (original code only)
- -- dp Generate messages for parser scope stack push/pops
-@@ -80,7 +80,7 @@ package body Debug is
- -- dN No file name information in exception messages
- -- dO Output immediate error messages
- -- dP Do not check for controlled objects in preelaborable packages
-- -- dQ Enable inlining in GNATprove mode
-+ -- dQ
- -- dR Bypass check for correct version of s-rpc
- -- dS Never convert numbers to machine numbers in Sem_Eval
- -- dT Convert to machine numbers only for constant declarations
-@@ -98,10 +98,10 @@ package body Debug is
- -- d.e Enable atomic synchronization
- -- d.f Inhibit folding of static expressions
- -- d.g Enable conversion of raise into goto
-- -- d.h
-+ -- d.h Minimize the creation of public internal symbols for concatenation
- -- d.i Ignore Warnings pragmas
- -- d.j Generate listing of frontend inlined calls
-- -- d.k Enable new support for frontend inlining
-+ -- d.k
- -- d.l Use Ada 95 semantics for limited function returns
- -- d.m For -gnatl, print full source only for main unit
- -- d.n Print source file names
-@@ -116,12 +116,12 @@ package body Debug is
- -- d.w Do not check for infinite loops
- -- d.x No exception handlers
- -- d.y
-- -- d.z
-+ -- d.z Restore previous support for frontend handling of Inline_Always
-
- -- d.A Read/write Aspect_Specifications hash table to tree
- -- d.B
- -- d.C Generate concatenation call, do not generate inline code
-- -- d.D
-+ -- d.D Disable errors on use of overriding keyword in Ada 95 mode
- -- d.E Turn selected errors into warnings
- -- d.F Debug mode for GNATprove
- -- d.G Ignore calls through generic formal parameters for elaboration
-@@ -139,11 +139,11 @@ package body Debug is
- -- d.S Force Optimize_Alignment (Space)
- -- d.T Force Optimize_Alignment (Time)
- -- d.U Ignore indirect calls for static elaboration
-- -- d.V View generated C code
-+ -- d.V
- -- d.W Print out debugging information for Walk_Library_Items
-- -- d.X
-+ -- d.X Old treatment of indexing aspects
- -- d.Y
-- -- d.Z
-+ -- d.Z Do not enable expansion in configurable run-time mode
-
- -- d1 Error msgs have node numbers where possible
- -- d2 Eliminate error flags in verbose form error messages
-@@ -151,7 +151,7 @@ package body Debug is
- -- d4 Inhibit automatic krunch of predefined library unit files
- -- d5 Debug output for tree read/write
- -- d6 Default access unconstrained to thin pointers
-- -- d7 Do not output version & file time stamp in -gnatv or -gnatl mode
-+ -- d7 Suppress version/source stamp/compilation time for -gnatv/-gnatl
- -- d8 Force opposite endianness in packed stuff
- -- d9 Allow lock free implementation
-
-@@ -249,7 +249,7 @@ package body Debug is
- -- output (dt) or recreated source output (dg,do,ds) includes only
- -- the main unit. If df is set, then the output in either case
- -- includes all compiled units (see also dg,do,ds,dt). Note that to
-- -- be effective, this swich must be used in combination with one or
-+ -- be effective, this switch must be used in combination with one or
- -- more of dt, dg, do or ds.
-
- -- dg Print the source recreated from the generated tree. In the case
-@@ -281,14 +281,6 @@ package body Debug is
- -- generated each time a request is made to the library manager to
- -- load a new unit.
-
-- -- dm Some features are permitted only in OpenVMS ports of GNAT (e.g.
-- -- the specification of passing by descriptor). Normally any use
-- -- of these features will be flagged as an error, but this debug
-- -- flag allows acceptance of these features in non OpenVMS ports.
-- -- Of course they may not have any useful effect, and in particular
-- -- attempting to generate code with this flag set may blow up.
-- -- The flag also forces the use of 64-bits for Long_Integer.
--
- -- dn Generate messages for node/list allocation. Each time a node or
- -- list header is allocated, a line of output is generated. Certain
- -- other basic tree operations also cause a line of output to be
-@@ -438,10 +430,6 @@ package body Debug is
- -- in preelaborable packages, but this restriction is a huge pain,
- -- especially in the predefined library units.
-
-- -- dQ Enable inlining in GNATprove mode. Although expansion is not set in
-- -- GNATprove mode, inlining is useful for improving the precision of
-- -- formal verification. Under a debug flag until fully reliable.
--
- -- dR Bypass the check for a proper version of s-rpc being present
- -- to use the -gnatz? switch. This allows debugging of the use
- -- of stubs generation without needing to have GLADE (or some
-@@ -537,6 +525,11 @@ package body Debug is
- -- this if this debug flag is set. Later we will enable this more
- -- generally by default.
-
-+ -- d.h Minimize the creation of public internal symbols for concatenation
-+ -- by enforcing a secondary stack-like handling of the final result.
-+ -- The target of the concatenation is thus constrained in place and
-+ -- initialized with the result instead of acting as its alias.
-+
- -- d.i Ignore all occurrences of pragma Warnings in the sources. This can
- -- be used in particular to disable Warnings (Off) to check if any of
- -- these statements are inappropriate.
-@@ -545,10 +538,6 @@ package body Debug is
- -- to the backend. This is useful to locate skipped calls that must be
- -- inlined by the frontend.
-
-- -- d.k Enable new semantics of frontend inlining. This is useful to test
-- -- this new feature in all the platforms. What *is* this new semantics
-- -- which doesn't seem to be documented anywhere???
--
- -- d.l Use Ada 95 semantics for limited function returns. This may be
- -- used to work around the incompatibility introduced by AI-318-2.
- -- It is useful only in -gnat05 mode.
-@@ -598,6 +587,13 @@ package body Debug is
- -- fully compiled and analyzed, they just get eliminated from the
- -- code generation step.
-
-+ -- d.z Restore previous front-end support for Inline_Always. In default
-+ -- mode, for targets that use the GCC back end (i.e. currently all
-+ -- targets except AAMP, .NET, JVM, and GNATprove), Inline_Always is
-+ -- handled by the back end. Use of this switch restores the previous
-+ -- handling of Inline_Always by the front end on such targets. For the
-+ -- targets that do not use the GCC back end, this switch is ignored.
-+
- -- d.A There seems to be a problem with ASIS if we activate the circuit
- -- for reading and writing the aspect specification hash table, so
- -- for now, this is controlled by the debug flag d.A. The hash table
-@@ -606,6 +602,10 @@ package body Debug is
- -- d.C Generate call to System.Concat_n.Str_Concat_n routines in cases
- -- where we would normally generate inline concatenation code.
-
-+ -- d.D For compatibility with some Ada 95 compilers implementing only
-+ -- one feature of Ada 2005 (overriding keyword), disable errors on use
-+ -- of overriding keyword in Ada 95 mode.
-+
- -- d.E Turn selected errors into warnings. This debug switch causes a
- -- specific set of error messages into warnings. Setting this switch
- -- causes Opt.Error_To_Warning to be set to True. The intention is
-@@ -685,13 +685,22 @@ package body Debug is
- -- reverts to the behavior of earlier compilers, which ignored
- -- indirect calls.
-
-- -- d.V Causes routines in Cprint to be called instead of corresponding
-- -- routines in Sprint. Used during development of Cprint.
--
- -- d.W Print out debugging information for Walk_Library_Items, including
- -- the order in which units are walked. This is primarily for use in
- -- debugging CodePeer mode.
-
-+ -- d.X A previous version of GNAT allowed indexing aspects to be
-+ -- redefined on derived container types, while the default iterator
-+ -- was inherited from the aprent type. This non-standard extension
-+ -- is preserved temporarily for use by the modelling project under
-+ -- debug flag d.X.
-+
-+ -- d.Z Normally we always enable expansion in configurable run-time mode
-+ -- to make sure we get error messages about unsupported features even
-+ -- when compiling in -gnatc mode. But expansion is turned off in this
-+ -- case if debug flag -gnatd.Z is used. This is to deal with the case
-+ -- where we discover difficulties in this new processing.
-+
- -- d1 Error messages have node numbers where possible. Normally error
- -- messages have only source locations. This option is useful when
- -- debugging errors caused by expanded code, where the source location
-@@ -724,10 +733,11 @@ package body Debug is
- -- implications of using thin pointers, and also to test that the
- -- compiler functions correctly with this choice.
-
-- -- d7 Normally a -gnatl or -gnatv listing includes the time stamp
-- -- of the source file. This debug flag suppresses this output,
-- -- and also suppresses the message with the version number.
-- -- This is useful in certain regression tests.
-+ -- d7 Normally a -gnatl or -gnatv listing includes the time stamp of the
-+ -- source file and the time of the compilation. This debug flag can
-+ -- be used to suppress this output, and also suppresses the message
-+ -- with the version of the compiler. This is useful for regression
-+ -- tests which need to have consistent output.
-
- -- d8 This forces the packed stuff to generate code assuming the
- -- opposite endianness from the actual correct value. Useful in
-@@ -793,7 +803,9 @@ package body Debug is
-
- -- dn Do not delete temporary files created by gnatmake at the end
- -- of execution, such as temporary config pragma files, mapping
-- -- files or project path files.
-+ -- files or project path files. This debug switch is equivalent to
-+ -- the standard switch --keep-temp-files. We retain the debug switch
-+ -- for back compatibility with past usage.
-
- -- dp Prints the Q used by routine Make.Compile_Sources every time
- -- we go around the main compile loop of Make.Compile_Sources
-@@ -815,9 +827,13 @@ package body Debug is
- -- Documentation for gprbuild Debug Flags --
- ---------------------------------------------
-
-- -- dn Do not delete temporary files createed by gprbuild at the end
-+ -- dm Display the maximum number of simultaneous compilations.
-+
-+ -- dn Do not delete temporary files created by gprbuild at the end
- -- of execution, such as temporary config pragma files, mapping
-- -- files or project path files.
-+ -- files or project path files. This debug switch is equivalent to
-+ -- the standard switch --keep-temp-files. We retain the debug switch
-+ -- for back compatibility with past usage.
-
- -- dt When a time stamp mismatch has been found for an ALI file,
- -- display the source file name, the time stamp expected and
-diff --git a/gnat/debug.ads b/gnat/debug.ads
-index 6fd0adb..9ebaa52 100644
---- a/gnat/debug.ads
-+++ b/gnat/debug.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/einfo.adb b/gnat/einfo.adb
-index 5875105..cfed66f 100644
---- a/gnat/einfo.adb
-+++ b/gnat/einfo.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -115,22 +115,17 @@ package body Einfo is
- -- RM_Size Uint13
-
- -- Alignment Uint14
-- -- First_Optional_Parameter Node14
- -- Normalized_Position Uint14
- -- Shadow_Entities List14
-
- -- Discriminant_Number Uint15
- -- DT_Position Uint15
- -- DT_Entry_Count Uint15
-- -- Entry_Bodies_Array Node15
- -- Entry_Parameters_Type Node15
- -- Extra_Formal Node15
-- -- Lit_Indexes Node15
-+ -- Pending_Access_Types Elist15
- -- Related_Instance Node15
- -- Status_Flag_Or_Transient_Decl Node15
-- -- Scale_Value Uint15
-- -- Storage_Size_Variable Node15
-- -- String_Literal_Low_Bound Node15
-
- -- Access_Disp_Table Elist16
- -- Body_References Elist16
-@@ -139,6 +134,7 @@ package body Einfo is
- -- Entry_Formal Node16
- -- First_Private_Entity Node16
- -- Lit_Strings Node16
-+ -- Scale_Value Uint16
- -- String_Literal_Length Uint16
- -- Unset_Reference Node16
-
-@@ -160,14 +156,17 @@ package body Einfo is
- -- Delta_Value Ureal18
- -- Enclosing_Scope Node18
- -- Equivalent_Type Node18
-+ -- Lit_Indexes Node18
- -- Private_Dependents Elist18
- -- Renamed_Entity Node18
- -- Renamed_Object Node18
-+ -- String_Literal_Low_Bound Node18
-
- -- Body_Entity Node19
- -- Corresponding_Discriminant Node19
- -- Default_Aspect_Component_Value Node19
- -- Default_Aspect_Value Node19
-+ -- Entry_Bodies_Array Node19
- -- Extra_Accessibility_Of_Result Node19
- -- Parent_Subtype Node19
- -- Size_Check_Code Node19
-@@ -195,7 +194,6 @@ package body Einfo is
- -- Component_Size Uint22
- -- Corresponding_Remote_Type Node22
- -- Enumeration_Rep_Expr Node22
-- -- Exception_Code Uint22
- -- Original_Record_Component Node22
- -- Private_View Node22
- -- Protected_Formal Node22
-@@ -228,10 +226,9 @@ package body Einfo is
-
- -- Dispatch_Table_Wrappers Elist26
- -- Last_Assignment Node26
-- -- Original_Access_Type Node26
- -- Overridden_Operation Node26
- -- Package_Instantiation Node26
-- -- Relative_Deadline_Variable Node26
-+ -- Storage_Size_Variable Node26
-
- -- Current_Use_Clause Node27
- -- Related_Type Node27
-@@ -240,6 +237,8 @@ package body Einfo is
- -- Extra_Formals Node28
- -- Finalizer Node28
- -- Initialization_Statements Node28
-+ -- Original_Access_Type Node28
-+ -- Relative_Deadline_Variable Node28
- -- Underlying_Record_View Node28
-
- -- BIP_Initialization_Call Node29
-@@ -253,6 +252,7 @@ package body Einfo is
- -- Thunk_Entity Node31
-
- -- SPARK_Pragma Node32
-+ -- No_Tagged_Streams_Pragma Node32
-
- -- Linker_Section_Pragma Node33
- -- SPARK_Aux_Pragma Node33
-@@ -270,6 +270,9 @@ package body Einfo is
- -- sense for them to be set true for certain subsets of entity kinds. See
- -- the spec of Einfo for further details.
-
-+ -- Is_Inlined_Always Flag1
-+ -- Is_Hidden_Non_Overridden_Subpgm Flag2
-+ -- Has_Default_Init_Cond Flag3
- -- Is_Frozen Flag4
- -- Has_Discriminants Flag5
- -- Is_Dispatching_Operation Flag6
-@@ -411,9 +414,9 @@ package body Einfo is
- -- Is_Generic_Instance Flag130
-
- -- No_Pool_Assigned Flag131
-- -- Is_AST_Entry Flag132
-- -- Is_VMS_Exception Flag133
-- -- Is_Optional_Parameter Flag134
-+ -- Is_Default_Init_Cond_Procedure Flag132
-+ -- Has_Inherited_Default_Init_Cond Flag133
-+ -- Returns_Limited_View Flag134
- -- Has_Aliased_Components Flag135
- -- No_Strict_Aliasing Flag136
- -- Is_Machine_Code_Subprogram Flag137
-@@ -564,20 +567,16 @@ package body Einfo is
- -- Has_Static_Predicate Flag269
- -- Stores_Attribute_Old_Prefix Flag270
-
-- -- (Has_Protected) Flag271
-- -- (SSO_Set_Low_By_Default) Flag272
-- -- (SSO_Set_Low_By_Default) Flag273
-+ -- Has_Protected Flag271
-+ -- SSO_Set_Low_By_Default Flag272
-+ -- SSO_Set_High_By_Default Flag273
-+ -- Is_Generic_Actual_Subprogram Flag274
-+ -- No_Predicate_On_Actual Flag275
-+ -- No_Dynamic_Predicate_On_Actual Flag276
-+ -- Is_Checked_Ghost_Entity Flag277
-+ -- Is_Ignored_Ghost_Entity Flag278
-+ -- Contains_Ignored_Ghost_Code Flag279
-
-- -- (unused) Flag1
-- -- (unused) Flag2
-- -- (unused) Flag3
--
-- -- (unused) Flag274
-- -- (unused) Flag275
-- -- (unused) Flag276
-- -- (unused) Flag277
-- -- (unused) Flag278
-- -- (unused) Flag279
- -- (unused) Flag280
-
- -- (unused) Flag281
-@@ -1095,7 +1094,7 @@ package body Einfo is
-
- function Entry_Bodies_Array (Id : E) return E is
- begin
-- return Node15 (Id);
-+ return Node19 (Id);
- end Entry_Bodies_Array;
-
- function Entry_Cancel_Parameter (Id : E) return E is
-@@ -1119,6 +1118,21 @@ package body Einfo is
- return Node18 (Id);
- end Entry_Index_Constant;
-
-+ function Contains_Ignored_Ghost_Code (Id : E) return B is
-+ begin
-+ pragma Assert
-+ (Ekind_In (Id, E_Block,
-+ E_Function,
-+ E_Generic_Function,
-+ E_Generic_Package,
-+ E_Generic_Procedure,
-+ E_Package,
-+ E_Package_Body,
-+ E_Procedure,
-+ E_Subprogram_Body));
-+ return Flag279 (Id);
-+ end Contains_Ignored_Ghost_Code;
-+
- function Contract (Id : E) return N is
- begin
- pragma Assert
-@@ -1129,8 +1143,7 @@ package body Einfo is
- E_Package_Body,
- E_Subprogram_Body,
- E_Variable)
-- or else Is_Generic_Subprogram (Id)
-- or else Is_Subprogram (Id));
-+ or else Is_Subprogram_Or_Generic_Subprogram (Id));
- return Node34 (Id);
- end Contract;
-
-@@ -1181,12 +1194,6 @@ package body Einfo is
- return Uint12 (Id);
- end Esize;
-
-- function Exception_Code (Id : E) return Uint is
-- begin
-- pragma Assert (Ekind (Id) = E_Exception);
-- return Uint22 (Id);
-- end Exception_Code;
--
- function Extra_Accessibility (Id : E) return E is
- begin
- pragma Assert
-@@ -1268,12 +1275,6 @@ package body Einfo is
- return Node17 (Id);
- end First_Literal;
-
-- function First_Optional_Parameter (Id : E) return E is
-- begin
-- pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
-- return Node14 (Id);
-- end First_Optional_Parameter;
--
- function First_Private_Entity (Id : E) return E is
- begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
-@@ -1404,6 +1405,11 @@ package body Einfo is
- return Flag39 (Base_Type (Id));
- end Has_Default_Aspect;
-
-+ function Has_Default_Init_Cond (Id : E) return B is
-+ begin
-+ return Flag3 (Id);
-+ end Has_Default_Init_Cond;
-+
- function Has_Delayed_Aspects (Id : E) return B is
- begin
- pragma Assert (Nkind (Id) in N_Entity);
-@@ -1478,8 +1484,7 @@ package body Einfo is
-
- function Has_Independent_Components (Id : E) return B is
- begin
-- pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
-- return Flag34 (Base_Type (Id));
-+ return Flag34 (Implementation_Base_Type (Id));
- end Has_Independent_Components;
-
- function Has_Inheritable_Invariants (Id : E) return B is
-@@ -1488,6 +1493,12 @@ package body Einfo is
- return Flag248 (Id);
- end Has_Inheritable_Invariants;
-
-+ function Has_Inherited_Default_Init_Cond (Id : E) return B is
-+ begin
-+ pragma Assert (Is_Type (Id));
-+ return Flag133 (Id);
-+ end Has_Inherited_Default_Init_Cond;
-+
- function Has_Initial_Value (Id : E) return B is
- begin
- pragma Assert (Ekind (Id) = E_Variable or else Is_Formal (Id));
-@@ -1900,12 +1911,6 @@ package body Einfo is
- return Flag15 (Id);
- end Is_Aliased;
-
-- function Is_AST_Entry (Id : E) return B is
-- begin
-- pragma Assert (Is_Entry (Id));
-- return Flag132 (Id);
-- end Is_AST_Entry;
--
- function Is_Asynchronous (Id : E) return B is
- begin
- pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
-@@ -1933,6 +1938,12 @@ package body Einfo is
- return Flag63 (Id);
- end Is_Character_Type;
-
-+ function Is_Checked_Ghost_Entity (Id : E) return B is
-+ begin
-+ pragma Assert (Nkind (Id) in N_Entity);
-+ return Flag277 (Id);
-+ end Is_Checked_Ghost_Entity;
-+
- function Is_Child_Unit (Id : E) return B is
- begin
- return Flag73 (Id);
-@@ -1991,6 +2002,12 @@ package body Einfo is
- return Flag74 (Id);
- end Is_CPP_Class;
-
-+ function Is_Default_Init_Cond_Procedure (Id : E) return B is
-+ begin
-+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
-+ return Flag132 (Id);
-+ end Is_Default_Init_Cond_Procedure;
-+
- function Is_Descendent_Of_Address (Id : E) return B is
- begin
- return Flag223 (Id);
-@@ -2053,6 +2070,12 @@ package body Einfo is
- return Flag4 (Id);
- end Is_Frozen;
-
-+ function Is_Generic_Actual_Subprogram (Id : E) return B is
-+ begin
-+ pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
-+ return Flag274 (Id);
-+ end Is_Generic_Actual_Subprogram;
-+
- function Is_Generic_Actual_Type (Id : E) return B is
- begin
- pragma Assert (Is_Type (Id));
-@@ -2075,11 +2098,22 @@ package body Einfo is
- return Flag57 (Id);
- end Is_Hidden;
-
-+ function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B is
-+ begin
-+ return Flag2 (Id);
-+ end Is_Hidden_Non_Overridden_Subpgm;
-+
- function Is_Hidden_Open_Scope (Id : E) return B is
- begin
- return Flag171 (Id);
- end Is_Hidden_Open_Scope;
-
-+ function Is_Ignored_Ghost_Entity (Id : E) return B is
-+ begin
-+ pragma Assert (Nkind (Id) in N_Entity);
-+ return Flag278 (Id);
-+ end Is_Ignored_Ghost_Entity;
-+
- function Is_Immediately_Visible (Id : E) return B is
- begin
- pragma Assert (Nkind (Id) in N_Entity);
-@@ -2098,7 +2132,6 @@ package body Einfo is
-
- function Is_Independent (Id : E) return B is
- begin
-- pragma Assert (Ekind (Id) = E_Component);
- return Flag268 (Id);
- end Is_Independent;
-
-@@ -2107,6 +2140,12 @@ package body Einfo is
- return Flag11 (Id);
- end Is_Inlined;
-
-+ function Is_Inlined_Always (Id : E) return B is
-+ begin
-+ pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
-+ return Flag1 (Id);
-+ end Is_Inlined_Always;
-+
- function Is_Interface (Id : E) return B is
- begin
- return Flag186 (Id);
-@@ -2136,7 +2175,7 @@ package body Einfo is
-
- function Is_Invariant_Procedure (Id : E) return B is
- begin
-- pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
-+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
- return Flag257 (Id);
- end Is_Invariant_Procedure;
-
-@@ -2204,12 +2243,6 @@ package body Einfo is
- return Flag226 (Id);
- end Is_Only_Out_Parameter;
-
-- function Is_Optional_Parameter (Id : E) return B is
-- begin
-- pragma Assert (Is_Formal (Id));
-- return Flag134 (Id);
-- end Is_Optional_Parameter;
--
- function Is_Package_Body_Entity (Id : E) return B is
- begin
- return Flag160 (Id);
-@@ -2281,7 +2314,7 @@ package body Einfo is
-
- function Is_Processed_Transient (Id : E) return B is
- begin
-- pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
-+ pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
- return Flag252 (Id);
- end Is_Processed_Transient;
-
-@@ -2407,11 +2440,6 @@ package body Einfo is
- return Flag116 (Id);
- end Is_Visible_Lib_Unit;
-
-- function Is_VMS_Exception (Id : E) return B is
-- begin
-- return Flag133 (Id);
-- end Is_VMS_Exception;
--
- function Is_Volatile (Id : E) return B is
- begin
- pragma Assert (Nkind (Id) in N_Entity);
-@@ -2478,7 +2506,7 @@ package body Einfo is
- function Lit_Indexes (Id : E) return E is
- begin
- pragma Assert (Is_Enumeration_Type (Id));
-- return Node15 (Id);
-+ return Node18 (Id);
- end Lit_Indexes;
-
- function Lit_Strings (Id : E) return E is
-@@ -2561,12 +2589,24 @@ package body Einfo is
- return Node12 (Id);
- end Next_Inlined_Subprogram;
-
-+ function No_Dynamic_Predicate_On_Actual (Id : E) return Boolean is
-+ begin
-+ pragma Assert (Is_Discrete_Type (Id));
-+ return Flag276 (Id);
-+ end No_Dynamic_Predicate_On_Actual;
-+
- function No_Pool_Assigned (Id : E) return B is
- begin
- pragma Assert (Is_Access_Type (Id));
- return Flag131 (Root_Type (Id));
- end No_Pool_Assigned;
-
-+ function No_Predicate_On_Actual (Id : E) return Boolean is
-+ begin
-+ pragma Assert (Is_Discrete_Type (Id));
-+ return Flag275 (Id);
-+ end No_Predicate_On_Actual;
-+
- function No_Return (Id : E) return B is
- begin
- return Flag113 (Id);
-@@ -2578,6 +2618,12 @@ package body Einfo is
- return Flag136 (Base_Type (Id));
- end No_Strict_Aliasing;
-
-+ function No_Tagged_Streams_Pragma (Id : E) return N is
-+ begin
-+ pragma Assert (Is_Tagged_Type (Id));
-+ return Node32 (Id);
-+ end No_Tagged_Streams_Pragma;
-+
- function Non_Binary_Modulus (Id : E) return B is
- begin
- pragma Assert (Is_Type (Id));
-@@ -2644,7 +2690,7 @@ package body Einfo is
- function Original_Access_Type (Id : E) return E is
- begin
- pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
-- return Node26 (Id);
-+ return Node28 (Id);
- end Original_Access_Type;
-
- function Original_Array_Type (Id : E) return E is
-@@ -2693,6 +2739,12 @@ package body Einfo is
- return Elist9 (Id);
- end Part_Of_Constituents;
-
-+ function Pending_Access_Types (Id : E) return L is
-+ begin
-+ pragma Assert (Is_Type (Id));
-+ return Elist15 (Id);
-+ end Pending_Access_Types;
-+
- function Postcondition_Proc (Id : E) return E is
- begin
- pragma Assert (Ekind (Id) = E_Procedure);
-@@ -2808,7 +2860,7 @@ package body Einfo is
- function Relative_Deadline_Variable (Id : E) return E is
- begin
- pragma Assert (Is_Task_Type (Id));
-- return Node26 (Implementation_Base_Type (Id));
-+ return Node28 (Implementation_Base_Type (Id));
- end Relative_Deadline_Variable;
-
- function Renamed_Entity (Id : E) return N is
-@@ -2853,6 +2905,12 @@ package body Einfo is
- return Flag90 (Id);
- end Returns_By_Ref;
-
-+ function Returns_Limited_View (Id : E) return B is
-+ begin
-+ pragma Assert (Ekind (Id) = E_Function);
-+ return Flag134 (Id);
-+ end Returns_Limited_View;
-+
- function Reverse_Bit_Order (Id : E) return B is
- begin
- pragma Assert (Is_Record_Type (Id));
-@@ -2878,7 +2936,7 @@ package body Einfo is
-
- function Scale_Value (Id : E) return U is
- begin
-- return Uint15 (Id);
-+ return Uint16 (Id);
- end Scale_Value;
-
- function Scope_Depth_Value (Id : E) return U is
-@@ -3012,7 +3070,7 @@ package body Einfo is
- function Storage_Size_Variable (Id : E) return E is
- begin
- pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
-- return Node15 (Implementation_Base_Type (Id));
-+ return Node26 (Implementation_Base_Type (Id));
- end Storage_Size_Variable;
-
- function Static_Elaboration_Desired (Id : E) return B is
-@@ -3052,7 +3110,7 @@ package body Einfo is
-
- function String_Literal_Low_Bound (Id : E) return N is
- begin
-- return Node15 (Id);
-+ return Node18 (Id);
- end String_Literal_Low_Bound;
-
- function Subprograms_For_Type (Id : E) return E is
-@@ -3068,7 +3126,7 @@ package body Einfo is
-
- function Suppress_Initialization (Id : E) return B is
- begin
-- pragma Assert (Is_Type (Id));
-+ pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
- return Flag105 (Id);
- end Suppress_Initialization;
-
-@@ -3382,6 +3440,13 @@ package body Einfo is
- return Ekind (Id) in Subprogram_Kind;
- end Is_Subprogram;
-
-+ function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B is
-+ begin
-+ return Ekind (Id) in Subprogram_Kind
-+ or else
-+ Ekind (Id) in Generic_Subprogram_Kind;
-+ end Is_Subprogram_Or_Generic_Subprogram;
-+
- function Is_Task_Type (Id : E) return B is
- begin
- return Ekind (Id) in Task_Kind;
-@@ -3518,6 +3583,13 @@ package body Einfo is
- Set_Flag38 (Id, V);
- end Set_Can_Never_Be_Null;
-
-+ procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
-+ begin
-+ pragma Assert
-+ (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
-+ Set_Flag229 (Id, V);
-+ end Set_Can_Use_Internal_Rep;
-+
- procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is
- begin
- Set_Flag31 (Id, V);
-@@ -3559,6 +3631,36 @@ package body Einfo is
- Set_Node20 (Id, V);
- end Set_Component_Type;
-
-+ procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True) is
-+ begin
-+ pragma Assert
-+ (Ekind_In (Id, E_Block,
-+ E_Function,
-+ E_Generic_Function,
-+ E_Generic_Package,
-+ E_Generic_Procedure,
-+ E_Package,
-+ E_Package_Body,
-+ E_Procedure,
-+ E_Subprogram_Body));
-+ Set_Flag279 (Id, V);
-+ end Set_Contains_Ignored_Ghost_Code;
-+
-+ procedure Set_Contract (Id : E; V : N) is
-+ begin
-+ pragma Assert
-+ (Ekind_In (Id, E_Entry,
-+ E_Entry_Family,
-+ E_Generic_Package,
-+ E_Package,
-+ E_Package_Body,
-+ E_Subprogram_Body,
-+ E_Variable,
-+ E_Void)
-+ or else Is_Subprogram_Or_Generic_Subprogram (Id));
-+ Set_Node34 (Id, V);
-+ end Set_Contract;
-+
- procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is
- begin
- pragma Assert
-@@ -3825,7 +3927,7 @@ package body Einfo is
-
- procedure Set_Entry_Bodies_Array (Id : E; V : E) is
- begin
-- Set_Node15 (Id, V);
-+ Set_Node19 (Id, V);
- end Set_Entry_Bodies_Array;
-
- procedure Set_Entry_Cancel_Parameter (Id : E; V : E) is
-@@ -3849,22 +3951,6 @@ package body Einfo is
- Set_Node18 (Id, V);
- end Set_Entry_Index_Constant;
-
-- procedure Set_Contract (Id : E; V : N) is
-- begin
-- pragma Assert
-- (Ekind_In (Id, E_Entry,
-- E_Entry_Family,
-- E_Generic_Package,
-- E_Package,
-- E_Package_Body,
-- E_Subprogram_Body,
-- E_Variable,
-- E_Void)
-- or else Is_Generic_Subprogram (Id)
-- or else Is_Subprogram (Id));
-- Set_Node34 (Id, V);
-- end Set_Contract;
--
- procedure Set_Entry_Parameters_Type (Id : E; V : E) is
- begin
- Set_Node15 (Id, V);
-@@ -3911,12 +3997,6 @@ package body Einfo is
- Set_Uint12 (Id, V);
- end Set_Esize;
-
-- procedure Set_Exception_Code (Id : E; V : U) is
-- begin
-- pragma Assert (Ekind (Id) = E_Exception);
-- Set_Uint22 (Id, V);
-- end Set_Exception_Code;
--
- procedure Set_Extra_Accessibility (Id : E; V : E) is
- begin
- pragma Assert
-@@ -3951,13 +4031,6 @@ package body Einfo is
- Set_Node28 (Id, V);
- end Set_Extra_Formals;
-
-- procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is
-- begin
-- pragma Assert
-- (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id));
-- Set_Flag229 (Id, V);
-- end Set_Can_Use_Internal_Rep;
--
- procedure Set_Finalization_Master (Id : E; V : E) is
- begin
- pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
-@@ -3999,12 +4072,6 @@ package body Einfo is
- Set_Node17 (Id, V);
- end Set_First_Literal;
-
-- procedure Set_First_Optional_Parameter (Id : E; V : E) is
-- begin
-- pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
-- Set_Node14 (Id, V);
-- end Set_First_Optional_Parameter;
--
- procedure Set_First_Private_Entity (Id : E; V : E) is
- begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
-@@ -4150,6 +4217,12 @@ package body Einfo is
- Set_Flag39 (Id, V);
- end Set_Has_Default_Aspect;
-
-+ procedure Set_Has_Default_Init_Cond (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Is_Type (Id));
-+ Set_Flag3 (Id, V);
-+ end Set_Has_Default_Init_Cond;
-+
- procedure Set_Has_Delayed_Aspects (Id : E; V : B := True) is
- begin
- pragma Assert (Nkind (Id) in N_Entity);
-@@ -4225,8 +4298,7 @@ package body Einfo is
-
- procedure Set_Has_Independent_Components (Id : E; V : B := True) is
- begin
-- pragma Assert ((Is_Array_Type (Id) or else Is_Record_Type (Id))
-- and then Is_Base_Type (Id));
-+ pragma Assert (not Is_Type (Id) or else Is_Base_Type (Id));
- Set_Flag34 (Id, V);
- end Set_Has_Independent_Components;
-
-@@ -4236,6 +4308,12 @@ package body Einfo is
- Set_Flag248 (Id, V);
- end Set_Has_Inheritable_Invariants;
-
-+ procedure Set_Has_Inherited_Default_Init_Cond (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Is_Type (Id));
-+ Set_Flag133 (Id, V);
-+ end Set_Has_Inherited_Default_Init_Cond;
-+
- procedure Set_Has_Initial_Value (Id : E; V : B := True) is
- begin
- pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
-@@ -4664,12 +4742,6 @@ package body Einfo is
- Set_Flag15 (Id, V);
- end Set_Is_Aliased;
-
-- procedure Set_Is_AST_Entry (Id : E; V : B := True) is
-- begin
-- pragma Assert (Is_Entry (Id));
-- Set_Flag132 (Id, V);
-- end Set_Is_AST_Entry;
--
- procedure Set_Is_Asynchronous (Id : E; V : B := True) is
- begin
- pragma Assert
-@@ -4700,6 +4772,26 @@ package body Einfo is
- Set_Flag63 (Id, V);
- end Set_Is_Character_Type;
-
-+ procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Is_Formal (Id)
-+ or else Is_Object (Id)
-+ or else Is_Package_Or_Generic_Package (Id)
-+ or else Is_Subprogram_Or_Generic_Subprogram (Id)
-+ or else Is_Type (Id)
-+ or else Ekind (Id) = E_Abstract_State
-+ or else Ekind (Id) = E_Component
-+ or else Ekind (Id) = E_Discriminant
-+ or else Ekind (Id) = E_Exception
-+ or else Ekind (Id) = E_Package_Body
-+ or else Ekind (Id) = E_Subprogram_Body
-+
-+ -- Allow this attribute to appear on non-analyzed entities
-+
-+ or else Ekind (Id) = E_Void);
-+ Set_Flag277 (Id, V);
-+ end Set_Is_Checked_Ghost_Entity;
-+
- procedure Set_Is_Child_Unit (Id : E; V : B := True) is
- begin
- Set_Flag73 (Id, V);
-@@ -4764,6 +4856,12 @@ package body Einfo is
- Set_Flag74 (Id, V);
- end Set_Is_CPP_Class;
-
-+ procedure Set_Is_Default_Init_Cond_Procedure (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Ekind (Id) = E_Procedure);
-+ Set_Flag132 (Id, V);
-+ end Set_Is_Default_Init_Cond_Procedure;
-+
- procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Type (Id));
-@@ -4834,6 +4932,12 @@ package body Einfo is
- Set_Flag4 (Id, V);
- end Set_Is_Frozen;
-
-+ procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
-+ Set_Flag274 (Id, V);
-+ end Set_Is_Generic_Actual_Subprogram;
-+
- procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Type (Id));
-@@ -4856,11 +4960,37 @@ package body Einfo is
- Set_Flag57 (Id, V);
- end Set_Is_Hidden;
-
-+ procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
-+ Set_Flag2 (Id, V);
-+ end Set_Is_Hidden_Non_Overridden_Subpgm;
-+
- procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True) is
- begin
- Set_Flag171 (Id, V);
- end Set_Is_Hidden_Open_Scope;
-
-+ procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Is_Formal (Id)
-+ or else Is_Object (Id)
-+ or else Is_Package_Or_Generic_Package (Id)
-+ or else Is_Subprogram_Or_Generic_Subprogram (Id)
-+ or else Is_Type (Id)
-+ or else Ekind (Id) = E_Abstract_State
-+ or else Ekind (Id) = E_Component
-+ or else Ekind (Id) = E_Discriminant
-+ or else Ekind (Id) = E_Exception
-+ or else Ekind (Id) = E_Package_Body
-+ or else Ekind (Id) = E_Subprogram_Body
-+
-+ -- Allow this attribute to appear on non-analyzed entities
-+
-+ or else Ekind (Id) = E_Void);
-+ Set_Flag278 (Id, V);
-+ end Set_Is_Ignored_Ghost_Entity;
-+
- procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
- begin
- pragma Assert (Nkind (Id) in N_Entity);
-@@ -4879,7 +5009,6 @@ package body Einfo is
-
- procedure Set_Is_Independent (Id : E; V : B := True) is
- begin
-- pragma Assert (Ekind_In (Id, E_Component, E_Void));
- Set_Flag268 (Id, V);
- end Set_Is_Independent;
-
-@@ -4888,6 +5017,12 @@ package body Einfo is
- Set_Flag11 (Id, V);
- end Set_Is_Inlined;
-
-+ procedure Set_Is_Inlined_Always (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
-+ Set_Flag1 (Id, V);
-+ end Set_Is_Inlined_Always;
-+
- procedure Set_Is_Interface (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Record_Type (Id));
-@@ -4918,7 +5053,7 @@ package body Einfo is
-
- procedure Set_Is_Invariant_Procedure (Id : E; V : B := True) is
- begin
-- pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
-+ pragma Assert (Ekind (Id) = E_Procedure);
- Set_Flag257 (Id, V);
- end Set_Is_Invariant_Procedure;
-
-@@ -4988,12 +5123,6 @@ package body Einfo is
- Set_Flag226 (Id, V);
- end Set_Is_Only_Out_Parameter;
-
-- procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is
-- begin
-- pragma Assert (Is_Formal (Id));
-- Set_Flag134 (Id, V);
-- end Set_Is_Optional_Parameter;
--
- procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
- begin
- Set_Flag160 (Id, V);
-@@ -5066,7 +5195,7 @@ package body Einfo is
-
- procedure Set_Is_Processed_Transient (Id : E; V : B := True) is
- begin
-- pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
-+ pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
- Set_Flag252 (Id, V);
- end Set_Is_Processed_Transient;
-
-@@ -5202,12 +5331,6 @@ package body Einfo is
- Set_Flag116 (Id, V);
- end Set_Is_Visible_Lib_Unit;
-
-- procedure Set_Is_VMS_Exception (Id : E; V : B := True) is
-- begin
-- pragma Assert (Ekind (Id) = E_Exception);
-- Set_Flag133 (Id, V);
-- end Set_Is_VMS_Exception;
--
- procedure Set_Is_Volatile (Id : E; V : B := True) is
- begin
- pragma Assert (Nkind (Id) in N_Entity);
-@@ -5270,7 +5393,7 @@ package body Einfo is
- procedure Set_Lit_Indexes (Id : E; V : E) is
- begin
- pragma Assert (Is_Enumeration_Type (Id) and then Root_Type (Id) = Id);
-- Set_Node15 (Id, V);
-+ Set_Node18 (Id, V);
- end Set_Lit_Indexes;
-
- procedure Set_Lit_Strings (Id : E; V : E) is
-@@ -5354,12 +5477,24 @@ package body Einfo is
- Set_Node12 (Id, V);
- end Set_Next_Inlined_Subprogram;
-
-+ procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Is_Discrete_Type (Id));
-+ Set_Flag276 (Id, V);
-+ end Set_No_Dynamic_Predicate_On_Actual;
-+
- procedure Set_No_Pool_Assigned (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id));
- Set_Flag131 (Id, V);
- end Set_No_Pool_Assigned;
-
-+ procedure Set_No_Predicate_On_Actual (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Is_Discrete_Type (Id));
-+ Set_Flag275 (Id, V);
-+ end Set_No_Predicate_On_Actual;
-+
- procedure Set_No_Return (Id : E; V : B := True) is
- begin
- pragma Assert
-@@ -5373,6 +5508,12 @@ package body Einfo is
- Set_Flag136 (Id, V);
- end Set_No_Strict_Aliasing;
-
-+ procedure Set_No_Tagged_Streams_Pragma (Id : E; V : E) is
-+ begin
-+ pragma Assert (Is_Tagged_Type (Id));
-+ Set_Node32 (Id, V);
-+ end Set_No_Tagged_Streams_Pragma;
-+
- procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
-@@ -5442,7 +5583,7 @@ package body Einfo is
- procedure Set_Original_Access_Type (Id : E; V : E) is
- begin
- pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
-- Set_Node26 (Id, V);
-+ Set_Node28 (Id, V);
- end Set_Original_Access_Type;
-
- procedure Set_Original_Array_Type (Id : E; V : E) is
-@@ -5491,6 +5632,12 @@ package body Einfo is
- Set_Elist9 (Id, V);
- end Set_Part_Of_Constituents;
-
-+ procedure Set_Pending_Access_Types (Id : E; V : L) is
-+ begin
-+ pragma Assert (Is_Type (Id));
-+ Set_Elist15 (Id, V);
-+ end Set_Pending_Access_Types;
-+
- procedure Set_Postcondition_Proc (Id : E; V : E) is
- begin
- pragma Assert (Ekind (Id) = E_Procedure);
-@@ -5614,7 +5761,7 @@ package body Einfo is
- procedure Set_Relative_Deadline_Variable (Id : E; V : E) is
- begin
- pragma Assert (Is_Task_Type (Id) and then Is_Base_Type (Id));
-- Set_Node26 (Id, V);
-+ Set_Node28 (Id, V);
- end Set_Relative_Deadline_Variable;
-
- procedure Set_Renamed_Entity (Id : E; V : N) is
-@@ -5659,6 +5806,12 @@ package body Einfo is
- Set_Flag90 (Id, V);
- end Set_Returns_By_Ref;
-
-+ procedure Set_Returns_Limited_View (Id : E; V : B := True) is
-+ begin
-+ pragma Assert (Ekind (Id) = E_Function);
-+ Set_Flag134 (Id, V);
-+ end Set_Returns_Limited_View;
-+
- procedure Set_Reverse_Bit_Order (Id : E; V : B := True) is
- begin
- pragma Assert
-@@ -5687,7 +5840,7 @@ package body Einfo is
-
- procedure Set_Scale_Value (Id : E; V : U) is
- begin
-- Set_Uint15 (Id, V);
-+ Set_Uint16 (Id, V);
- end Set_Scale_Value;
-
- procedure Set_Scope_Depth_Value (Id : E; V : U) is
-@@ -5832,7 +5985,7 @@ package body Einfo is
- begin
- pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
- pragma Assert (Id = Base_Type (Id));
-- Set_Node15 (Id, V);
-+ Set_Node26 (Id, V);
- end Set_Storage_Size_Variable;
-
- procedure Set_Static_Elaboration_Desired (Id : E; V : B) is
-@@ -5875,7 +6028,7 @@ package body Einfo is
- procedure Set_String_Literal_Low_Bound (Id : E; V : N) is
- begin
- pragma Assert (Ekind (Id) = E_String_Literal_Subtype);
-- Set_Node15 (Id, V);
-+ Set_Node18 (Id, V);
- end Set_String_Literal_Low_Bound;
-
- procedure Set_Subprograms_For_Type (Id : E; V : E) is
-@@ -5891,7 +6044,7 @@ package body Einfo is
-
- procedure Set_Suppress_Initialization (Id : E; V : B := True) is
- begin
-- pragma Assert (Is_Type (Id));
-+ pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
- Set_Flag105 (Id, V);
- end Set_Suppress_Initialization;
-
-@@ -6408,6 +6561,31 @@ package body Einfo is
- end loop;
- end Declaration_Node;
-
-+ ---------------------------------
-+ -- Default_Init_Cond_Procedure --
-+ ---------------------------------
-+
-+ function Default_Init_Cond_Procedure (Id : E) return E is
-+ S : Entity_Id;
-+
-+ begin
-+ pragma Assert
-+ (Is_Type (Id)
-+ and then (Has_Default_Init_Cond (Id)
-+ or Has_Inherited_Default_Init_Cond (Id)));
-+
-+ S := Subprograms_For_Type (Id);
-+ while Present (S) loop
-+ if Is_Default_Init_Cond_Procedure (S) then
-+ return S;
-+ end if;
-+
-+ S := Subprograms_For_Type (S);
-+ end loop;
-+
-+ return Empty;
-+ end Default_Init_Cond_Procedure;
-+
- ---------------------
- -- Designated_Type --
- ---------------------
-@@ -6594,31 +6772,32 @@ package body Einfo is
-
- function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is
- Is_CDG : constant Boolean :=
-- Id = Pragma_Abstract_State or else
-- Id = Pragma_Async_Readers or else
-- Id = Pragma_Async_Writers or else
-- Id = Pragma_Depends or else
-- Id = Pragma_Effective_Reads or else
-- Id = Pragma_Effective_Writes or else
-- Id = Pragma_Global or else
-- Id = Pragma_Initial_Condition or else
-- Id = Pragma_Initializes or else
-- Id = Pragma_Part_Of or else
-- Id = Pragma_Refined_Depends or else
-- Id = Pragma_Refined_Global or else
-+ Id = Pragma_Abstract_State or else
-+ Id = Pragma_Async_Readers or else
-+ Id = Pragma_Async_Writers or else
-+ Id = Pragma_Depends or else
-+ Id = Pragma_Effective_Reads or else
-+ Id = Pragma_Effective_Writes or else
-+ Id = Pragma_Extensions_Visible or else
-+ Id = Pragma_Global or else
-+ Id = Pragma_Initial_Condition or else
-+ Id = Pragma_Initializes or else
-+ Id = Pragma_Part_Of or else
-+ Id = Pragma_Refined_Depends or else
-+ Id = Pragma_Refined_Global or else
- Id = Pragma_Refined_State;
- Is_CTC : constant Boolean :=
-- Id = Pragma_Contract_Cases or else
-+ Id = Pragma_Contract_Cases or else
- Id = Pragma_Test_Case;
- Is_PPC : constant Boolean :=
-- Id = Pragma_Precondition or else
-- Id = Pragma_Postcondition or else
-+ Id = Pragma_Precondition or else
-+ Id = Pragma_Postcondition or else
- Id = Pragma_Refined_Post;
-
- In_Contract : constant Boolean := Is_CDG or Is_CTC or Is_PPC;
-
-- Item : Node_Id;
-- Items : Node_Id;
-+ Item : Node_Id;
-+ Items : Node_Id;
-
- begin
- -- Handle pragmas that appear in N_Contract nodes. Those have to be
-@@ -7065,36 +7244,6 @@ package body Einfo is
- return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer;
- end Is_Finalizer;
-
-- ---------------------
-- -- Is_Ghost_Entity --
-- ---------------------
--
-- -- Note: coding below allows for ghost variables. They are not currently
-- -- implemented, so we will always get False for variables, but that is
-- -- expected to change in the future.
--
-- function Is_Ghost_Entity (Id : E) return B is
-- begin
-- if Present (Id) and then Ekind (Id) = E_Variable then
-- return Convention (Id) = Convention_Ghost;
-- else
-- return Is_Ghost_Subprogram (Id);
-- end if;
-- end Is_Ghost_Entity;
--
-- -------------------------
-- -- Is_Ghost_Subprogram --
-- -------------------------
--
-- function Is_Ghost_Subprogram (Id : E) return B is
-- begin
-- if Present (Id) and then Ekind_In (Id, E_Function, E_Procedure) then
-- return Convention (Id) = Convention_Ghost;
-- else
-- return False;
-- end if;
-- end Is_Ghost_Subprogram;
--
- -------------------
- -- Is_Null_State --
- -------------------
-@@ -7192,6 +7341,29 @@ package body Einfo is
- end if;
- end Is_Standard_Character_Type;
-
-+ -----------------------------
-+ -- Is_Standard_String_Type --
-+ -----------------------------
-+
-+ function Is_Standard_String_Type (Id : E) return B is
-+ begin
-+ if Is_Type (Id) then
-+ declare
-+ R : constant Entity_Id := Root_Type (Id);
-+ begin
-+ return
-+ R = Standard_String
-+ or else
-+ R = Standard_Wide_String
-+ or else
-+ R = Standard_Wide_Wide_String;
-+ end;
-+
-+ else
-+ return False;
-+ end if;
-+ end Is_Standard_String_Type;
-+
- --------------------
- -- Is_String_Type --
- --------------------
-@@ -7342,13 +7514,6 @@ package body Einfo is
- when others => return No_Uint;
- end case;
-
-- when VAX_Native =>
-- case Digs is
-- when 1 .. 9 => return 2**7 - 1;
-- when 10 .. 15 => return 2**10 - 1;
-- when others => return No_Uint;
-- end case;
--
- when AAMP =>
- return Uint_2 ** Uint_7 - Uint_1;
- end case;
-@@ -7362,7 +7527,6 @@ package body Einfo is
- begin
- case Float_Rep (Id) is
- when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
-- when VAX_Native => return -Machine_Emax_Value (Id);
- when AAMP => return -Machine_Emax_Value (Id);
- end case;
- end Machine_Emin_Value;
-@@ -7385,14 +7549,6 @@ package body Einfo is
- when others => return No_Uint;
- end case;
-
-- when VAX_Native =>
-- case Digs is
-- when 1 .. 6 => return Uint_24;
-- when 7 .. 9 => return UI_From_Int (56);
-- when 10 .. 15 => return UI_From_Int (53);
-- when others => return No_Uint;
-- end case;
--
- when AAMP =>
- case Digs is
- when 1 .. 6 => return Uint_24;
-@@ -7409,7 +7565,7 @@ package body Einfo is
- function Machine_Radix_Value (Id : E) return U is
- begin
- case Float_Rep (Id) is
-- when IEEE_Binary | VAX_Native | AAMP =>
-+ when IEEE_Binary | AAMP =>
- return Uint_2;
- end case;
- end Machine_Radix_Value;
-@@ -7851,7 +8007,6 @@ package body Einfo is
- (Num => Significand * 2 ** (Exponent mod 4),
- Den => -Exponent / 4,
- Rbase => 16);
--
- else
- return
- UR_From_Components
-@@ -7927,6 +8082,34 @@ package body Einfo is
- end case;
- end Set_Component_Alignment;
-
-+ -------------------------------------
-+ -- Set_Default_Init_Cond_Procedure --
-+ -------------------------------------
-+
-+ procedure Set_Default_Init_Cond_Procedure (Id : E; V : E) is
-+ S : Entity_Id;
-+
-+ begin
-+ pragma Assert
-+ (Is_Type (Id) and then (Has_Default_Init_Cond (Id)
-+ or
-+ Has_Inherited_Default_Init_Cond (Id)));
-+
-+ S := Subprograms_For_Type (Id);
-+ Set_Subprograms_For_Type (Id, V);
-+ Set_Subprograms_For_Type (V, S);
-+
-+ -- Check for a duplicate procedure
-+
-+ while Present (S) loop
-+ if Is_Default_Init_Cond_Procedure (S) then
-+ raise Program_Error;
-+ end if;
-+
-+ S := Subprograms_For_Type (S);
-+ end loop;
-+ end Set_Default_Init_Cond_Procedure;
-+
- -----------------------------
- -- Set_Invariant_Procedure --
- -----------------------------
-@@ -8132,7 +8315,7 @@ package body Einfo is
- elsif Ekind (Id) in Incomplete_Or_Private_Kind then
-
- -- If we have an incomplete or private type with a full view,
-- -- then we return the Underlying_Type of this full view
-+ -- then we return the Underlying_Type of this full view.
-
- if Present (Full_View (Id)) then
- if Id = Full_View (Id) then
-@@ -8145,6 +8328,14 @@ package body Einfo is
- return Underlying_Type (Full_View (Id));
- end if;
-
-+ -- If we have a private type with an underlying full view, then we
-+ -- return the Underlying_Type of this underlying full view.
-+
-+ elsif Ekind (Id) in Private_Kind
-+ and then Present (Underlying_Full_View (Id))
-+ then
-+ return Underlying_Type (Underlying_Full_View (Id));
-+
- -- If we have an incomplete entity that comes from the limited
- -- view then we return the Underlying_Type of its non-limited
- -- view.
-@@ -8169,24 +8360,14 @@ package body Einfo is
- return Empty;
- end if;
-
-- -- For non-incomplete, non-private types, return the type itself
-- -- Also for entities that are not types at all return the entity
-- -- itself.
-+ -- For non-incomplete, non-private types, return the type itself Also
-+ -- for entities that are not types at all return the entity itself.
-
- else
- return Id;
- end if;
- end Underlying_Type;
-
-- ---------------
-- -- Vax_Float --
-- ---------------
--
-- function Vax_Float (Id : E) return B is
-- begin
-- return Is_Floating_Point_Type (Id) and then Float_Rep (Id) = VAX_Native;
-- end Vax_Float;
--
- ------------------------
- -- Write_Entity_Flags --
- ------------------------
-@@ -8241,6 +8422,7 @@ package body Einfo is
- W ("C_Pass_By_Copy", Flag125 (Id));
- W ("Can_Never_Be_Null", Flag38 (Id));
- W ("Checks_May_Be_Suppressed", Flag31 (Id));
-+ W ("Contains_Ignored_Ghost_Code", Flag279 (Id));
- W ("Debug_Info_Off", Flag166 (Id));
- W ("Default_Expressions_Processed", Flag108 (Id));
- W ("Delay_Cleanups", Flag114 (Id));
-@@ -8268,6 +8450,7 @@ package body Einfo is
- W ("Has_Controlling_Result", Flag98 (Id));
- W ("Has_Convention_Pragma", Flag119 (Id));
- W ("Has_Default_Aspect", Flag39 (Id));
-+ W ("Has_Default_Init_Cond", Flag3 (Id));
- W ("Has_Delayed_Aspects", Flag200 (Id));
- W ("Has_Delayed_Freeze", Flag18 (Id));
- W ("Has_Delayed_Rep_Aspects", Flag261 (Id));
-@@ -8283,6 +8466,7 @@ package body Einfo is
- W ("Has_Implicit_Dereference", Flag251 (Id));
- W ("Has_Independent_Components", Flag34 (Id));
- W ("Has_Inheritable_Invariants", Flag248 (Id));
-+ W ("Has_Inherited_Default_Init_Cond", Flag133 (Id));
- W ("Has_Initial_Value", Flag219 (Id));
- W ("Has_Invariants", Flag232 (Id));
- W ("Has_Loop_Entry_Attributes", Flag260 (Id));
-@@ -8342,10 +8526,8 @@ package body Einfo is
- W ("In_Package_Body", Flag48 (Id));
- W ("In_Private_Part", Flag45 (Id));
- W ("In_Use", Flag8 (Id));
-- W ("Is_AST_Entry", Flag132 (Id));
- W ("Is_Abstract_Subprogram", Flag19 (Id));
-- W ("Is_Abstract_Type", Flag146 (Id));
-- W ("Is_Local_Anonymous_Access", Flag194 (Id));
-+ W ("Is_Abstract_Type", Flag146 (Id));
- W ("Is_Access_Constant", Flag69 (Id));
- W ("Is_Ada_2005_Only", Flag185 (Id));
- W ("Is_Ada_2012_Only", Flag199 (Id));
-@@ -8356,6 +8538,7 @@ package body Einfo is
- W ("Is_CPP_Class", Flag74 (Id));
- W ("Is_Called", Flag102 (Id));
- W ("Is_Character_Type", Flag63 (Id));
-+ W ("Is_Checked_Ghost_Entity", Flag277 (Id));
- W ("Is_Child_Unit", Flag73 (Id));
- W ("Is_Class_Wide_Equivalent_Type", Flag35 (Id));
- W ("Is_Compilation_Unit", Flag149 (Id));
-@@ -8367,6 +8550,7 @@ package body Einfo is
- W ("Is_Constructor", Flag76 (Id));
- W ("Is_Controlled", Flag42 (Id));
- W ("Is_Controlling_Formal", Flag97 (Id));
-+ W ("Is_Default_Init_Cond_Procedure", Flag132 (Id));
- W ("Is_Descendent_Of_Address", Flag223 (Id));
- W ("Is_Discrim_SO_Function", Flag176 (Id));
- W ("Is_Discriminant_Check_Function", Flag264 (Id));
-@@ -8379,16 +8563,20 @@ package body Einfo is
- W ("Is_For_Access_Subtype", Flag118 (Id));
- W ("Is_Formal_Subprogram", Flag111 (Id));
- W ("Is_Frozen", Flag4 (Id));
-+ W ("Is_Generic_Actual_Subprogram", Flag274 (Id));
- W ("Is_Generic_Actual_Type", Flag94 (Id));
- W ("Is_Generic_Instance", Flag130 (Id));
- W ("Is_Generic_Type", Flag13 (Id));
- W ("Is_Hidden", Flag57 (Id));
-+ W ("Is_Hidden_Non_Overridden_Subpgm", Flag2 (Id));
- W ("Is_Hidden_Open_Scope", Flag171 (Id));
-+ W ("Is_Ignored_Ghost_Entity", Flag278 (Id));
- W ("Is_Immediately_Visible", Flag7 (Id));
- W ("Is_Implementation_Defined", Flag254 (Id));
- W ("Is_Imported", Flag24 (Id));
- W ("Is_Independent", Flag268 (Id));
- W ("Is_Inlined", Flag11 (Id));
-+ W ("Is_Inlined_Always", Flag1 (Id));
- W ("Is_Instantiated", Flag126 (Id));
- W ("Is_Interface", Flag186 (Id));
- W ("Is_Internal", Flag17 (Id));
-@@ -8402,12 +8590,12 @@ package body Einfo is
- W ("Is_Limited_Composite", Flag106 (Id));
- W ("Is_Limited_Interface", Flag197 (Id));
- W ("Is_Limited_Record", Flag25 (Id));
-+ W ("Is_Local_Anonymous_Access", Flag194 (Id));
- W ("Is_Machine_Code_Subprogram", Flag137 (Id));
- W ("Is_Non_Static_Subtype", Flag109 (Id));
- W ("Is_Null_Init_Proc", Flag178 (Id));
- W ("Is_Obsolescent", Flag153 (Id));
- W ("Is_Only_Out_Parameter", Flag226 (Id));
-- W ("Is_Optional_Parameter", Flag134 (Id));
- W ("Is_Package_Body_Entity", Flag160 (Id));
- W ("Is_Packed", Flag51 (Id));
- W ("Is_Packed_Array_Impl_Type", Flag138 (Id));
-@@ -8441,7 +8629,6 @@ package body Einfo is
- W ("Is_Unchecked_Union", Flag117 (Id));
- W ("Is_Underlying_Record_View", Flag246 (Id));
- W ("Is_Unsigned_Type", Flag144 (Id));
-- W ("Is_VMS_Exception", Flag133 (Id));
- W ("Is_Valued_Procedure", Flag127 (Id));
- W ("Is_Visible_Formal", Flag206 (Id));
- W ("Is_Visible_Lib_Unit", Flag116 (Id));
-@@ -8459,7 +8646,9 @@ package body Einfo is
- W ("Needs_Debug_Info", Flag147 (Id));
- W ("Needs_No_Actuals", Flag22 (Id));
- W ("Never_Set_In_Source", Flag115 (Id));
-+ W ("No_Dynamic_Predicate_On_actual", Flag276 (Id));
- W ("No_Pool_Assigned", Flag131 (Id));
-+ W ("No_Predicate_On_actual", Flag275 (Id));
- W ("No_Return", Flag113 (Id));
- W ("No_Strict_Aliasing", Flag136 (Id));
- W ("Non_Binary_Modulus", Flag58 (Id));
-@@ -8477,6 +8666,7 @@ package body Einfo is
- W ("Requires_Overriding", Flag213 (Id));
- W ("Return_Present", Flag54 (Id));
- W ("Returns_By_Ref", Flag90 (Id));
-+ W ("Returns_Limited_View", Flag134 (Id));
- W ("Reverse_Bit_Order", Flag164 (Id));
- W ("Reverse_Storage_Order", Flag93 (Id));
- W ("Sec_Stack_Needed_For_Return", Flag167 (Id));
-@@ -8885,10 +9075,6 @@ package body Einfo is
- E_Loop_Parameter =>
- Write_Str ("Alignment");
-
-- when E_Function |
-- E_Procedure =>
-- Write_Str ("First_Optional_Parameter");
--
- when E_Component |
- E_Discriminant =>
- Write_Str ("Normalized_Position");
-@@ -8919,36 +9105,23 @@ package body Einfo is
- E_Procedure =>
- Write_Str ("DT_Position");
-
-- when E_Protected_Type =>
-- Write_Str ("Entry_Bodies_Array");
--
- when Entry_Kind =>
- Write_Str ("Entry_Parameters_Type");
-
- when Formal_Kind =>
- Write_Str ("Extra_Formal");
-
-- when Enumeration_Kind =>
-- Write_Str ("Lit_Indexes");
-+ when Type_Kind =>
-+ Write_Str ("Pending_Access_Types");
-
- when E_Package |
- E_Package_Body =>
- Write_Str ("Related_Instance");
-
-- when Decimal_Fixed_Point_Kind =>
-- Write_Str ("Scale_Value");
--
- when E_Constant |
- E_Variable =>
- Write_Str ("Status_Flag_Or_Transient_Decl");
-
-- when Access_Kind |
-- Task_Kind =>
-- Write_Str ("Storage_Size_Variable");
--
-- when E_String_Literal_Subtype =>
-- Write_Str ("String_Literal_Low_Bound");
--
- when others =>
- Write_Str ("Field15??");
- end case;
-@@ -8987,6 +9160,9 @@ package body Einfo is
- when Enumeration_Kind =>
- Write_Str ("Lit_Strings");
-
-+ when Decimal_Fixed_Point_Kind =>
-+ Write_Str ("Scale_Value");
-+
- when E_String_Literal_Subtype =>
- Write_Str ("String_Literal_Length");
-
-@@ -9109,6 +9285,9 @@ package body Einfo is
- when Fixed_Point_Kind =>
- Write_Str ("Delta_Value");
-
-+ when Enumeration_Kind =>
-+ Write_Str ("Lit_Indexes");
-+
- when Incomplete_Or_Private_Kind |
- E_Record_Subtype =>
- Write_Str ("Private_Dependents");
-@@ -9123,6 +9302,9 @@ package body Einfo is
- E_Generic_Package =>
- Write_Str ("Renamed_Entity");
-
-+ when E_String_Literal_Subtype =>
-+ Write_Str ("String_Literal_Low_Bound");
-+
- when others =>
- Write_Str ("Field18??");
- end case;
-@@ -9148,6 +9330,14 @@ package body Einfo is
- when E_Array_Type =>
- Write_Str ("Default_Component_Value");
-
-+ when E_Protected_Type =>
-+ Write_Str ("Entry_Bodies_Array");
-+
-+ when E_Function |
-+ E_Operator |
-+ E_Subprogram_Type =>
-+ Write_Str ("Extra_Accessibility_Of_Result");
-+
- when E_Record_Type =>
- Write_Str ("Parent_Subtype");
-
-@@ -9162,9 +9352,6 @@ package body Einfo is
- when Private_Kind =>
- Write_Str ("Underlying_Full_View");
-
-- when E_Function | E_Operator | E_Subprogram_Type =>
-- Write_Str ("Extra_Accessibility_Of_Result");
--
- when others =>
- Write_Str ("Field19??");
- end case;
-@@ -9294,9 +9481,6 @@ package body Einfo is
- when E_Enumeration_Literal =>
- Write_Str ("Enumeration_Rep_Expr");
-
-- when E_Exception =>
-- Write_Str ("Exception_Code");
--
- when E_Record_Type_With_Private |
- E_Record_Subtype_With_Private |
- E_Private_Type |
-@@ -9478,8 +9662,9 @@ package body Einfo is
- E_Variable =>
- Write_Str ("Last_Assignment");
-
-- when E_Access_Subprogram_Type =>
-- Write_Str ("Original_Access_Type");
-+ when E_Procedure |
-+ E_Function =>
-+ Write_Str ("Overridden_Operation");
-
- when E_Generic_Package |
- E_Package =>
-@@ -9489,12 +9674,9 @@ package body Einfo is
- E_Constant =>
- Write_Str ("Related_Type");
-
-- when Task_Kind =>
-- Write_Str ("Relative_Deadline_Variable");
--
-- when E_Procedure |
-- E_Function =>
-- Write_Str ("Overridden_Operation");
-+ when Access_Kind |
-+ Task_Kind =>
-+ Write_Str ("Storage_Size_Variable");
-
- when others =>
- Write_Str ("Field26??");
-@@ -9549,6 +9731,12 @@ package body Einfo is
- E_Variable =>
- Write_Str ("Initialization_Statements");
-
-+ when E_Access_Subprogram_Type =>
-+ Write_Str ("Original_Access_Type");
-+
-+ when Task_Kind =>
-+ Write_Str ("Relative_Deadline_Variable");
-+
- when E_Record_Type =>
- Write_Str ("Underlying_Record_View");
-
-@@ -9634,6 +9822,9 @@ package body Einfo is
- E_Subprogram_Body =>
- Write_Str ("SPARK_Pragma");
-
-+ when Type_Kind =>
-+ Write_Str ("No_Tagged_Streams_Pragma");
-+
- when others =>
- Write_Str ("Field32??");
- end case;
-@@ -9694,6 +9885,7 @@ package body Einfo is
- case Ekind (Id) is
- when Subprogram_Kind =>
- Write_Str ("Import_Pragma");
-+
- when others =>
- Write_Str ("Field35??");
- end case;
-diff --git a/gnat/einfo.ads b/gnat/einfo.ads
-index 6359e09..ae714da 100644
---- a/gnat/einfo.ads
-+++ b/gnat/einfo.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -47,10 +47,10 @@ package Einfo is
- -- and they correspond to conventional symbol table information. Other
- -- attributes include sets of meanings for overloaded names, possible
- -- types for overloaded expressions, flags to indicate deferred constants,
---- incomplete types, etc. These attributes are stored in available fields
---- in tree nodes (i.e. fields not used by the parser, as defined by the
---- Sinfo package specification), and accessed by means of a set of
---- subprograms which define an abstract interface.
-+-- incomplete types, etc. These attributes are stored in available fields in
-+-- tree nodes (i.e. fields not used by the parser, as defined by the Sinfo
-+-- package specification), and accessed by means of a set of subprograms
-+-- which define an abstract interface.
-
- -- There are two kinds of semantic information
-
-@@ -82,10 +82,9 @@ package Einfo is
- --------------------------------
-
- -- XEINFO is a utility program which automatically produces a C header file,
---- einfo.h from the spec and body of package Einfo. It reads the input
---- files einfo.ads and einfo.adb and produces the output file einfo.h.
---- XEINFO is run automatically by the build scripts when you do a full
---- bootstrap.
-+-- einfo.h from the spec and body of package Einfo. It reads the input files
-+-- einfo.ads and einfo.adb and produces the output file einfo.h. XEINFO is run
-+-- automatically by the build scripts when you do a full bootstrap.
-
- -- In order for this utility program to operate correctly, the form of the
- -- einfo.ads and einfo.adb files must meet certain requirements and be laid
-@@ -149,7 +148,7 @@ package Einfo is
-
- -- The Object_Size for base subtypes reflect the natural hardware
- -- size in bits (see Ttypes and Cstand for integer types). For
---- enumeration and fixed-point base subtypes have 8. 16. 32 or 64
-+-- enumeration and fixed-point base subtypes have 8, 16, 32, or 64
- -- bits for this size, depending on the range of values to be stored.
-
- -- The Object_Size of a subtype is the same as the Object_Size of
-@@ -302,13 +301,13 @@ package Einfo is
- -- access functions and set procedures to set the corresponding values, while
- -- synthesized attributes have only access functions.
-
---- Note: in the case of Node, Uint, or Elist fields, there are cases where
---- the same physical field is used for different purposes in different
---- entities, so these access functions should only be referenced for the
---- class of entities in which they are defined as being present. Flags are
---- not overlapped in this way, but nevertheless as a matter of style and
---- abstraction (which may or may not be checked by assertions in the body),
---- this restriction should be observed for flag fields as well.
-+-- Note: in the case of Node, Uint, or Elist fields, there are cases where the
-+-- same physical field is used for different purposes in different entities,
-+-- so these access functions should only be referenced for the class of
-+-- entities in which they are defined as being present. Flags are not
-+-- overlapped in this way, but nevertheless as a matter of style and
-+-- abstraction (which may or may not be checked by assertions in the
-+-- body), this restriction should be observed for flag fields as well.
-
- -- Note: certain of the attributes on types apply only to base types, and
- -- are so noted by the notation [base type only]. These are cases where the
-@@ -321,7 +320,7 @@ package Einfo is
- -- Other attributes are noted as applying to the [implementation base type
- -- only]. These are representation attributes which must always apply to a
- -- full non-private type, and where the attributes are always on the full
---- type. The attribute can be referenced on a subtype (and automatically
-+-- type. The attribute can be referenced on a subtype (and automatically
- -- retries the value from the implementation base type). However, it is an
- -- error to try to set the attribute on other than the implementation base
- -- type, and if assertions are enabled, an attempt to set the attribute on a
-@@ -352,7 +351,7 @@ package Einfo is
- -- defined primitives, and 6) secondary dispatch table with predefined
- -- primitives. The last entity of this list is an access type declaration
- -- used to expand dispatching calls through the primary dispatch table.
---- For a non-tagged record, contains No_Elist.
-+-- For an untagged record, contains No_Elist.
-
- -- Actual_Subtype (Node17)
- -- Defined in variables, constants, and formal parameters. This is the
-@@ -390,8 +389,8 @@ package Einfo is
- -- case of subprograms to control output of certain warnings.
-
- -- Aft_Value (synthesized)
---- Applies to fixed and decimal types. Computes a universal integer
---- that holds value of the Aft attribute for the type.
-+-- Applies to fixed and decimal types. Computes a universal integer that
-+-- holds value of the Aft attribute for the type.
-
- -- Alias (Node18)
- -- Defined in overloadable entities (literals, subprograms, entries) and
-@@ -584,7 +583,7 @@ package Einfo is
- -- Class_Wide_Type (Node9)
- -- Defined in all type entities. For a tagged type or subtype, returns
- -- the corresponding implicitly declared class-wide type. For a
---- class-wide type, returns itself. Set to Empty for non-tagged types.
-+-- class-wide type, returns itself. Set to Empty for untagged types.
-
- -- Cloned_Subtype (Node16)
- -- Defined in E_Record_Subtype and E_Class_Wide_Subtype entities.
-@@ -662,6 +661,11 @@ package Einfo is
- -- Component_Type (Node20) [implementation base type only]
- -- Defined in array types and string types. References component type.
-
-+-- Contains_Ignored_Ghost_Code (Flag279)
-+-- Defined in blocks, packages and their bodies, subprograms and their
-+-- bodies. Set if the entity contains any ignored Ghost code in the form
-+-- of declaration, procedure call, assignment statement or pragma.
-+
- -- Corresponding_Concurrent_Type (Node18)
- -- Defined in record types that are constructed by the expander to
- -- represent task and protected types (Is_Concurrent_Record_Type flag
-@@ -773,6 +777,16 @@ package Einfo is
- -- default expressions (see Freeze.Process_Default_Expressions), which
- -- would not only waste time, but also generate false error messages.
-
-+-- Default_Init_Cond_Procedure (synthesized)
-+-- Defined in all types. Set for private [sub]types subject to pragma
-+-- Default_Initial_Condition, their corresponding full views and derived
-+-- types with at least one parent subject to the pragma. Contains the
-+-- entity of the procedure which takes a single argument of the given
-+-- type and verifies the assumption of the pragma.
-+--
-+-- Note: the reason this is marked as a synthesized attribute is that the
-+-- way this is stored is as an element of the Subprograms_For_Type field.
-+
- -- Default_Value (Node20)
- -- Defined in formal parameters. Points to the node representing the
- -- expression for the default value for the parameter. Empty if the
-@@ -937,7 +951,7 @@ package Einfo is
- -- Defined in E_Record_Type and E_Record_Subtype entities. Set in library
- -- level tagged type entities if we are generating statically allocated
- -- dispatch tables. Points to the list of dispatch table wrappers
---- associated with the tagged type. For a non-tagged record, contains
-+-- associated with the tagged type. For an untagged record, contains
- -- No_Elist.
-
- -- DTC_Entity (Node16)
-@@ -1022,7 +1036,7 @@ package Einfo is
- -- at least one accept for this entry in the task body. Used to
- -- generate warnings for missing accepts.
-
---- Entry_Bodies_Array (Node15)
-+-- Entry_Bodies_Array (Node19)
- -- Defined in protected types for which Has_Entries is true.
- -- This is the defining identifier for the array of entry body
- -- action procedures and barrier functions used by the runtime to
-@@ -1149,13 +1163,6 @@ package Einfo is
- -- Note one obscure case: for pragma Default_Storage_Pool (null), the
- -- Etype of the N_Null node is Empty.
-
---- Exception_Code (Uint22)
---- Defined in exception entities. Set to zero unless either an
---- Import_Exception or Export_Exception pragma applies to the
---- pragma and specifies a Code value. See description of these
---- pragmas for details. Note that this field is relevant only if
---- Is_VMS_Exception is set.
--
- -- Extra_Formal (Node15)
- -- Defined in formal parameters in the non-generic case. Certain
- -- parameters require extra implicit information to be passed (e.g. the
-@@ -1286,13 +1293,6 @@ package Einfo is
- -- Note that this field is set in enumeration subtypes, but it still
- -- points to the first literal of the base type in this case.
-
---- First_Optional_Parameter (Node14)
---- Defined in (non-generic) function and procedure entities. Set to a
---- non-null value only if a pragma Import_Function, Import_Procedure
---- or Import_Valued_Procedure specifies a First_Optional_Parameter
---- argument, in which case this field points to the parameter entity
---- corresponding to the specified parameter.
--
- -- First_Private_Entity (Node16)
- -- Defined in all entities containing private parts (packages, protected
- -- types and subtypes, task types and subtypes). The entities on the
-@@ -1489,6 +1489,17 @@ package Einfo is
- -- Convention, Import, or Export has been given. Used to prevent more
- -- than one such pragma appearing for a given entity (RM B.1(45)).
-
-+-- Has_Default_Aspect (Flag39) [base type only]
-+-- Defined in entities for types and subtypes, set for scalar types with
-+-- a Default_Value aspect and array types with a Default_Component_Value
-+-- apsect. If this flag is set, then a corresponding aspect specification
-+-- node will be present on the rep item chain for the entity.
-+
-+-- Has_Default_Init_Cond (Flag3)
-+-- Defined in type and subtype entities. Set if pragma Default_Initial_
-+-- Condition applies to the type or subtype. This flag must be mutually
-+-- exclusive with Has_Inherited_Default_Init_Cond.
-+
- -- Has_Delayed_Aspects (Flag200)
- -- Defined in all entities. Set if the Rep_Item chain for the entity has
- -- one or more N_Aspect_Definition nodes chained which are not to be
-@@ -1501,12 +1512,6 @@ package Einfo is
- -- node must be generated for the entity at its freezing point. See
- -- separate section ("Delayed Freezing and Elaboration") for details.
-
---- Has_Default_Aspect (Flag39) [base type only]
---- Defined in entities for types and subtypes, set for scalar types with
---- a Default_Value aspect and array types with a Default_Component_Value
---- apsect. If this flag is set, then a corresponding aspect specification
---- node will be present on the rep item chain for the entity.
--
- -- Has_Delayed_Rep_Aspects (Flag261)
- -- Defined in all type and subtypes. This flag is set if there is at
- -- least one aspect for a representation characteristic that has to be
-@@ -1605,11 +1610,16 @@ package Einfo is
- -- Implicit_Dereference. Set also on the discriminant named in the aspect
- -- clause, to simplify type resolution.
-
---- Has_Independent_Components (Flag34) [base type only]
---- Defined in types. Set if the aspect Independent_Components applies
---- (in the base type only), if corresponding pragma or aspect applies.
---- In the case of an object of anonymous array type, the flag is set on
---- the created array type.
-+-- Has_Independent_Components (Flag34) [implementation base type only]
-+-- Defined in all types and objects. Set only for a record type or an
-+-- array type or array object if a valid pragma Independent_Components
-+-- applies to the type or object. Note that in the case of an object,
-+-- this flag is only set on the object if there was an explicit pragma
-+-- for the object. In other words, the proper test for whether an object
-+-- has independent components is to see if either the object or its base
-+-- type has this flag set. Note that in the case of a type, the pragma
-+-- will be chained to the rep item chain of the first subtype in the
-+-- usual manner.
-
- -- Has_Inheritable_Invariants (Flag248)
- -- Defined in all type entities. Set in private types from which one
-@@ -1620,6 +1630,11 @@ package Einfo is
- -- type which has inheritable invariants, and in this case the flag will
- -- also be set in the private type.
-
-+-- Has_Inherited_Default_Init_Cond (Flag133)
-+-- Defined in type and subtype entities. Set if a derived type inherits
-+-- pragma Default_Initial_Condition from its parent type. This flag must
-+-- be mutually exclusive with Had_Default_Init_Cond.
-+
- -- Has_Initial_Value (Flag219)
- -- Defined in entities for variables and out parameters. Set if there
- -- is an explicit initial value expression in the declaration of the
-@@ -1814,14 +1829,12 @@ package Einfo is
- -- is defined for the type.
-
- -- Has_Private_Ancestor (Flag151)
---- Applies to untagged derived types and to type extensions. True when
---- some ancestor is derived from a private type, making some components
---- invisible and aggregates illegal. Used to check the legality of
---- selected components and aggregates. The flag is set at the point of
---- derivation. The legality of an aggregate of a type with a private
---- ancestor must be checked because it also depends on the visibility
---- at the point the aggregate is resolved. See sem_aggr.adb. This is
---- part of AI05-0115.
-+-- Applies to type extensions. True if some ancestor is derived from a
-+-- private type, making some components invisible and aggregates illegal.
-+-- This flag is set at the point of derivation. The legality of the
-+-- aggregate must be rechecked because it also depends on the visibility
-+-- at the point the aggregate is resolved. See sem_aggr.adb. This is part
-+-- of AI05-0115.
-
- -- Has_Private_Declaration (Flag155)
- -- Defined in all entities. Set if it is the defining entity of a private
-@@ -1910,7 +1923,7 @@ package Einfo is
- -- Has_Static_Predicate (Flag269)
- -- Defined in all types and subtypes. Set if the type (which must be a
- -- scalar type) has a predicate whose expression is predicate-static.
---- This can result from use of any of a Predicate, Static_Predicate, or
-+-- This can result from the use of any Predicate, Static_Predicate, or
- -- Dynamic_Predicate aspect. We can distinguish these cases by testing
- -- Has_Static_Predicate_Aspect and Has_Dynamic_Predicate_Aspect. See
- -- description of the latter flag for further information on dynamic
-@@ -1955,9 +1968,9 @@ package Einfo is
- -- Defined in all type entities. Set on unchecked unions themselves
- -- and (recursively) on any composite type which has a component for
- -- which Has_Unchecked_Union is set. The meaning is that a comparison
---- operation for the type is not permitted. Note that the flag is not
---- set on access types, even if they designate an object that has
---- the flag Has_Unchecked_Union set.
-+-- operation or 'Valid_Scalars reference for the type is not permitted.
-+-- Note that the flag is not set on access types, even if they designate
-+-- an object that has the flag Has_Unchecked_Union set.
-
- -- Has_Unknown_Discriminants (Flag72)
- -- Defined in all entities. Set for types with unknown discriminants.
-@@ -2027,10 +2040,10 @@ package Einfo is
-
- -- Import_Pragma (Node35)
- -- Defined in subprogram entities. Set if a valid pragma Import or pragma
---- Import_Function or pragma Import_Procedure aplies to the subprogram,
-+-- Import_Function or pragma Import_Procedure applies to the subprogram,
- -- in which case this field points to the pragma (we can't use the normal
- -- Rep_Item chain mechanism, because a single pragma Import can apply
---- to multiple subprogram entities.
-+-- to multiple subprogram entities).
-
- -- In_Package_Body (Flag48)
- -- Defined in package entities. Set on the entity that denotes the
-@@ -2069,13 +2082,11 @@ package Einfo is
- -- access to subprograms (JGNAT only). Set to Empty unless an export,
- -- import, or interface name pragma has explicitly specified an external
- -- name, in which case it references an N_String_Literal node for the
---- specified external name. In the case of exceptions, the field is set
---- by Import_Exception/Export_Exception (which can be used in OpenVMS
---- versions only). Note that if this field is Empty, and Is_Imported
---- or Is_Exported is set, then the default interface name is the name
---- of the entity, cased in a manner that is appropriate to the system
---- in use. Note that Interface_Name is ignored if an address clause
---- is present (since it is meaningless in this case).
-+-- specified external name. Note that if this field is Empty, and
-+-- Is_Imported or Is_Exported is set, then the default interface name
-+-- is the name of the entity, cased in a manner that is appropriate to
-+-- the system in use. Note that Interface_Name is ignored if an address
-+-- clause is present (since it is meaningless in this case).
- --
- -- An additional special case usage of this field is in JGNAT for
- -- E_Component and E_Discriminant. JGNAT allows these entities to be
-@@ -2149,13 +2160,6 @@ package Einfo is
- -- carry the keyword aliased, and on record components that have the
- -- keyword. For Ada 2012, also applies to formal parameters.
-
---- Is_AST_Entry (Flag132)
---- Defined in entry entities. Set if a valid pragma AST_Entry applies
---- to the entry. This flag can only be set in OpenVMS versions of GNAT.
---- Note: we also allow the flag to appear in entry families, but given
---- the current implementation of the pragma AST_Entry, this flag will
---- always be False in entry families.
--
- -- Is_Atomic (Flag85)
- -- Defined in all type entities, and also in constants, components and
- -- variables. Set if a pragma Atomic or Shared applies to the entity.
-@@ -2194,6 +2198,13 @@ package Einfo is
- -- Defined in all entities. Set for character types and subtypes,
- -- i.e. enumeration types that have at least one character literal.
-
-+-- Is_Checked_Ghost_Entity (Flag277)
-+-- Applies to all entities. Set for abstract states, [generic] packages,
-+-- [generic] subprograms, components, discriminants, formal parameters,
-+-- objects, package bodies, subprogram bodies, and [sub]types subject to
-+-- pragma Ghost or inherit "ghostness" from an enclosing construct, and
-+-- subject to Assertion_Policy Ghost => Check.
-+
- -- Is_Child_Unit (Flag73)
- -- Defined in all entities. Set only for defining entities of program
- -- units that are child units (but False for subunits).
-@@ -2281,6 +2292,10 @@ package Einfo is
- -- Applies to all type entities, true for decimal fixed point
- -- types and subtypes.
-
-+-- Is_Default_Init_Cond_Procedure (Flag132)
-+-- Defined in functions and procedures. Set for a generated procedure
-+-- which verifies the assumption of pragma Default_Initial_Condition.
-+
- -- Is_Descendent_Of_Address (Flag223)
- -- Defined in all entities. True if the entity is type System.Address,
- -- or (recursively) a subtype or derived type of System.Address.
-@@ -2345,7 +2360,7 @@ package Einfo is
- -- Defined in all entities. Set if the entity is exported. For now we
- -- only allow the export of constants, exceptions, functions, procedures
- -- and variables, but that may well change later on. Exceptions can only
---- be exported in the OpenVMS and Java VM implementations of GNAT.
-+-- be exported in the Java VM implementation of GNAT.
-
- -- Is_External_State (synthesized)
- -- Applies to all entities, true for abstract states that are subject to
-@@ -2389,10 +2404,24 @@ package Einfo is
- -- Defined in all type and subtype entities. Set if type or subtype has
- -- been frozen.
-
-+-- Is_Generic_Actual_Subprogram (Flag274)
-+-- Defined on functions and procedures. Set on the entity of the renaming
-+-- declaration created within an instance for an actual subprogram.
-+-- Used to generate constraint checks on calls to these subprograms, even
-+-- within an instance of a predefined run-time unit, in which checks
-+-- are otherwise suppressed.
-+--
-+-- The flag is also set on the entity of the expression function created
-+-- within an instance, for a function that has external axiomatization,
-+-- for use in GNATprove mode.
-+
- -- Is_Generic_Actual_Type (Flag94)
- -- Defined in all type and subtype entities. Set in the subtype
- -- declaration that renames the generic formal as a subtype of the
- -- actual. Guarantees that the subtype is not static within the instance.
-+-- Also used during analysis of an instance, to simplify resolution of
-+-- accidental overloading that occurs when different formal types get the
-+-- same actual.
-
- -- Is_Generic_Instance (Flag130)
- -- Defined in all entities. Set to indicate that the entity is an
-@@ -2413,18 +2442,6 @@ package Einfo is
- -- package, generic function, generic procedure), and False for all
- -- other entities.
-
---- Is_Ghost_Entity (synthesized)
---- Applies to all entities. Yields True for a subprogram or a whole
---- object that has convention Ghost. For now only functions can have
---- Ghost convention, so this will be false for other than functions,
---- but we expect that to change in the future.
--
---- Is_Ghost_Subprogram (synthesized)
---- Applies to all entities. Yields True for a subprogram that has a Ghost
---- convention. Note: for now, only ghost functions are allowed, so this
---- will always be false for procedures, but that is expected to change in
---- the future.
--
- -- Is_Hidden (Flag57)
- -- Defined in all entities. Set for all entities declared in the
- -- private part or body of a package. Also marks generic formals of a
-@@ -2435,11 +2452,24 @@ package Einfo is
- -- child unit, and when compiling a private child unit (see Install_
- -- Private_Declaration in sem_ch7).
-
-+-- Is_Hidden_Non_Overridden_Subpgm (Flag2)
-+-- Defined in all entities. Set for implicitly declared subprograms
-+-- that require overriding or are null procedures, and are hidden by
-+-- a non-fully conformant homograph with the same characteristics
-+-- (Ada RM 8.3 12.3/2).
-+
- -- Is_Hidden_Open_Scope (Flag171)
- -- Defined in all entities. Set for a scope that contains the
- -- instantiation of a child unit, and whose entities are not visible
- -- during analysis of the instance.
-
-+-- Is_Ignored_Ghost_Entity (Flag278)
-+-- Applies to all entities. Set for abstract states, [generic] packages,
-+-- [generic] subprograms, components, discriminants, formal parameters,
-+-- objects, package bodies, subprogram bodies, and [sub]types subject to
-+-- pragma Ghost or inherit "ghostness" from an enclosing construct, and
-+-- subject to Assertion_Policy Ghost => Ignore.
-+
- -- Is_Immediately_Visible (Flag7)
- -- Defined in all entities. Set if entity is immediately visible, i.e.
- -- is defined in some currently open scope (RM 8.3(4)).
-@@ -2453,9 +2483,8 @@ package Einfo is
- -- Is_Imported (Flag24)
- -- Defined in all entities. Set if the entity is imported. For now we
- -- only allow the import of exceptions, functions, procedures, packages.
---- and variables. Exceptions can only be imported in the OpenVMS and
---- Java VM implementations of GNAT. Packages and types can only be
---- imported in the Java VM implementation.
-+-- and variables. Exceptions, packages and types can only be imported in
-+-- the Java VM implementation.
-
- -- Is_Incomplete_Or_Private_Type (synthesized)
- -- Applies to all entities, true for private and incomplete types
-@@ -2464,9 +2493,13 @@ package Einfo is
- -- Applies to all entities, true for incomplete types and subtypes
-
- -- Is_Independent (Flag268)
---- Defined in record components. Set if a valid pragma or aspect
---- Independent applies to the component, or if a valid pragma or aspect
---- Independent_Components applies to the enclosing record type.
-+-- Defined in all type entities, and also in constants, components and
-+-- variables. Set if a valid pragma or aspect Independent applies to the
-+-- entity, or if a valid pragma or aspect Independent_Components applies
-+-- to the enclosing record type for a component. Also set if a pragma
-+-- Shared or pragma Atomic applies to the entity. In the case of private
-+-- and incomplete types, this flag is set in both the partial view and
-+-- the full view.
-
- -- Is_Inlined (Flag11)
- -- Defined in all entities. Set for functions and procedures which are
-@@ -2477,6 +2510,12 @@ package Einfo is
- -- inherited by their instances. It is also set on the body entities
- -- of inlined subprograms. See also Has_Pragma_Inline.
-
-+-- Is_Inlined_Always (Flag1)
-+-- Defined in subprograms. Set for functions and procedures which are
-+-- always inlined in GNATprove mode. GNATprove uses this flag to know
-+-- when a body does not need to be analyzed. The value of this flag is
-+-- only meaningful if Body_To_Inline is not Empty for the subprogram.
-+
- -- Is_Instantiated (Flag126)
- -- Defined in generic packages and generic subprograms. Set if the unit
- -- is instantiated from somewhere in the extended main source unit. This
-@@ -2697,11 +2736,6 @@ package Einfo is
- -- out parameter, or if there is some other IN OUT parameter then this
- -- flag is not set in any of them. Used in generation of warnings.
-
---- Is_Optional_Parameter (Flag134)
---- Defined in parameter entities. Set if the parameter is specified as
---- optional by use of a First_Optional_Parameter argument to one of the
---- extended Import pragmas. Can only be set for OpenVMS versions of GNAT.
--
- -- Is_Ordinary_Fixed_Point_Type (synthesized)
- -- Applies to all entities, true for ordinary fixed point types and
- -- subtypes.
-@@ -2789,7 +2823,7 @@ package Einfo is
- -- Is_Primitive (Flag218)
- -- Defined in overloadable entities and in generic subprograms. Set to
- -- indicate that this is a primitive operation of some type, which may
---- be a tagged type or a non-tagged type. Used to verify overriding
-+-- be a tagged type or an untagged type. Used to verify overriding
- -- indicators in bodies.
-
- -- Is_Primitive_Wrapper (Flag195)
-@@ -2826,10 +2860,11 @@ package Einfo is
- -- as well as for record with private types as subtypes
-
- -- Is_Processed_Transient (Flag252)
---- Defined in entities of variables and constants. Set when a transient
---- object needs to be finalized and it has already been processed by the
---- transient scope machinery. This flag signals the general finalization
---- mechanism to ignore the transient object.
-+-- Defined in variables, loop parameters, and constants, including the
-+-- loop parameters of generalized iterators. Set when a transient object
-+-- needs to be finalized and has already been processed by the transient
-+-- scope machinery. This flag signals the general finalization mechanism
-+-- to ignore the transient object.
-
- -- Is_Protected_Component (synthesized)
- -- Applicable to all entities, true if the entity denotes a private
-@@ -2921,9 +2956,14 @@ package Einfo is
-
- -- Is_Standard_Character_Type (synthesized)
- -- Applies to all entities, true for types and subtypes whose root type
---- is one of the standard character types (Character, Wide_Character,
-+-- is one of the standard character types (Character, Wide_Character, or
- -- Wide_Wide_Character).
-
-+-- Is_Standard_String_Type (synthesized)
-+-- Applies to all entities, true for types and subtypes whose root
-+-- type is one of the standard string types (String, Wide_String, or
-+-- Wide_Wide_String).
-+
- -- Is_Statically_Allocated (Flag28)
- -- Defined in all entities. This can only be set for exception,
- -- variable, constant, and type/subtype entities. If the flag is set,
-@@ -2950,6 +2990,10 @@ package Einfo is
- -- Applies to all entities, true for function, procedure and operator
- -- entities.
-
-+-- Is_Subprogram_Or_Generic_Subprogram
-+-- Applies to all entities, true for function procedure and operator
-+-- entities, and also for the corresponding generic entities.
-+
- -- Is_Synchronized_Interface (synthesized)
- -- Defined in types that are interfaces. True if interface is declared
- -- synchronized, task, or protected, or is derived from a synchronized
-@@ -2962,7 +3006,7 @@ package Einfo is
- -- vtable (i.e. the one to be extended by derivation).
-
- -- Is_Tagged_Type (Flag55)
---- Defined in all entities. Set for an entity for a tagged type.
-+-- Defined in all entities. Set for an entity that is a tagged type.
-
- -- Is_Task_Interface (synthesized)
- -- Defined in types that are interfaces. True if interface is declared as
-@@ -3046,12 +3090,6 @@ package Einfo is
- -- a separate flag must be used to indicate whether the names are visible
- -- by selected notation, or not.
-
---- Is_VMS_Exception (Flag133)
---- Defined in all entities. Set only for exception entities where the
---- exception was specified in an Import_Exception or Export_Exception
---- pragma with the VMS option for Form. See description of these pragmas
---- for details. This flag can only be set in OpenVMS versions of GNAT.
--
- -- Is_Volatile (Flag16)
- -- Defined in all type entities, and also in constants, components and
- -- variables. Set if a pragma Volatile applies to the entity. Also set
-@@ -3140,7 +3178,7 @@ package Einfo is
- -- field may be set as a result of a linker section pragma applied to the
- -- type of the object.
-
---- Lit_Indexes (Node15)
-+-- Lit_Indexes (Node18)
- -- Defined in enumeration types and subtypes. Non-empty only for the
- -- case of an enumeration root type, where it contains the entity for
- -- the generated indexes entity. See unit Exp_Imgv for full details of
-@@ -3339,6 +3377,42 @@ package Einfo is
- -- Empty if applied to the last literal. This is actually a synonym
- -- for Next, but its use is preferred in this context.
-
-+-- No_Dynamic_Predicate_On_Actual (Flag276)
-+-- Defined in discrete types. Set for generic formal types that are used
-+-- in loops and quantified expressions. The corresponing actual cannot
-+-- have dynamic predicates.
-+
-+-- No_Pool_Assigned (Flag131) [root type only]
-+-- Defined in access types. Set if a storage size clause applies to the
-+-- variable with a static expression value of zero. This flag is used to
-+-- generate errors if any attempt is made to allocate or free an instance
-+-- of such an access type. This is set only in the root type, since
-+-- derived types must have the same pool.
-+
-+-- No_Predicate_On_Actual (Flag275)
-+-- Defined in discrete types. Set for generic formal types that are used
-+-- in the spec of a generic package, in constructs that forbid discrete
-+-- types with predicates.
-+
-+-- No_Return (Flag113)
-+-- Defined in all entities. Always false except in the case of procedures
-+-- and generic procedures for which a pragma No_Return is given.
-+
-+-- No_Strict_Aliasing (Flag136) [base type only]
-+-- Defined in access types. Set to direct the backend to avoid any
-+-- optimizations based on an assumption about the aliasing status of
-+-- objects designated by the access type. For the case of the gcc
-+-- backend, the effect is as though all references to objects of
-+-- the type were compiled with -fno-strict-aliasing. This flag is
-+-- set if an unchecked conversion with the access type as a target
-+-- type occurs in the same source unit as the declaration of the
-+-- access type, or if an explicit pragma No_Strict_Aliasing applies.
-+
-+-- No_Tagged_Streams_Pragma (Node32)
-+-- Present in all subtype and type entities. Set for tagged types and
-+-- subtypes (i.e. entities with Is_Tagged_Type set True) if a valid
-+-- pragma/aspect applies to the type.
-+
- -- Non_Binary_Modulus (Flag58) [base type only]
- -- Defined in all subtype and type entities. Set for modular integer
- -- types if the modulus value is other than a power of 2.
-@@ -3353,17 +3427,6 @@ package Einfo is
- -- interpreted as true. Currently this is set for derived Boolean
- -- types which have a convention of C, C++ or Fortran.
-
---- No_Pool_Assigned (Flag131) [root type only]
---- Defined in access types. Set if a storage size clause applies to the
---- variable with a static expression value of zero. This flag is used to
---- generate errors if any attempt is made to allocate or free an instance
---- of such an access type. This is set only in the root type, since
---- derived types must have the same pool.
--
---- No_Return (Flag113)
---- Defined in all entities. Always false except in the case of procedures
---- and generic procedures for which a pragma No_Return is given.
--
- -- Normalized_First_Bit (Uint8)
- -- Defined in components and discriminants. Indicates the normalized
- -- value of First_Bit for the component, i.e. the offset within the
-@@ -3387,16 +3450,6 @@ package Einfo is
- -- the maximum size such records (needed for allocation purposes when
- -- there are default discriminants, and also for the 'Size value).
-
---- No_Strict_Aliasing (Flag136) [base type only]
---- Defined in access types. Set to direct the backend to avoid any
---- optimizations based on an assumption about the aliasing status of
---- objects designated by the access type. For the case of the gcc
---- backend, the effect is as though all references to objects of
---- the type were compiled with -fno-strict-aliasing. This flag is
---- set if an unchecked conversion with the access type as a target
---- type occurs in the same source unit as the declaration of the
---- access type, or if an explicit pragma No_Strict_Aliasing applies.
--
- -- Number_Dimensions (synthesized)
- -- Applies to array types and subtypes. Returns the number of dimensions
- -- of the array type or subtype as a value of type Pos.
-@@ -3442,7 +3495,7 @@ package Einfo is
- -- Optimize_Alignment (Off) mode applies to the type/object, then neither
- -- of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set.
-
---- Original_Access_Type (Node26)
-+-- Original_Access_Type (Node28)
- -- Defined in E_Access_Subprogram_Type entities. Set only if the access
- -- type was generated by the expander as part of processing an access
- -- to protected subprogram type. Points to the access to protected
-@@ -3468,7 +3521,7 @@ package Einfo is
- --
- -- Rec_Ext.Comp -> Rec_Ext.Parent. ... .Parent.Comp
- --
---- In base non-tagged types:
-+-- In base untagged types:
- -- Always points to itself except for non-girder discriminants, where
- -- it points to the girder discriminant it renames.
- --
-@@ -3525,6 +3578,14 @@ package Einfo is
- -- Present in abstract state entities. Contains all constituents that are
- -- subject to indicator Part_Of (both aspect and option variants).
-
-+-- Pending_Access_Types (Elist15)
-+-- Defined in all types. Set for incomplete, private, Taft-amendment
-+-- types, and their corresponding full views. This list contains all
-+-- access types, both named and anonymous, declared between the partial
-+-- and the full view. The list is used by the finalization machinery to
-+-- ensure that the finalization masters of all pending access types are
-+-- fully initialized when the full view is frozen.
-+
- -- Postcondition_Proc (Node8)
- -- Defined only in procedure entities, saves the entity of the generated
- -- postcondition proc if one is present, otherwise is set to Empty. Used
-@@ -3682,7 +3743,7 @@ package Einfo is
- -- associated dispatch table to point to entities containing primary or
- -- secondary tags. Not set in the _tag component of record types.
-
---- Relative_Deadline_Variable (Node26) [implementation base type only]
-+-- Relative_Deadline_Variable (Node28) [implementation base type only]
- -- Defined in task type entities. This flag is set if a valid and
- -- effective pragma Relative_Deadline applies to the base type. Points
- -- to the entity for a variable that is created to hold the value given
-@@ -3744,9 +3805,15 @@ package Einfo is
- -- even though it causes the whole function to return.
-
- -- Returns_By_Ref (Flag90)
---- Defined in function entities, to indicate that the function
---- returns the result by reference, either because its return type is a
---- by-reference-type or because it uses explicitly the secondary stack.
-+-- Defined in function entities. Set if the function returns the result
-+-- by reference, either because its return type is a by-reference-type
-+-- or because the function explicitly uses the secondary stack.
-+
-+-- Returns_Limited_View (Flag134)
-+-- Defined in function entities. Set if the return type of the function
-+-- at the point of definition is a limited view. Used to handle the late
-+-- freezing of the function when it is called in the current semantic
-+-- unit while it is still unfrozen.
-
- -- Reverse_Bit_Order (Flag164) [base type only]
- -- Defined in all record type entities. Set if entity has a Bit_Order
-@@ -3793,7 +3860,7 @@ package Einfo is
- -- node (with a constraint), or a Range node, but not a simple
- -- subtype reference (a subtype is converted into a range).
-
---- Scale_Value (Uint15)
-+-- Scale_Value (Uint16)
- -- Defined in decimal fixed-point types and subtypes. Contains the scale
- -- for the type (i.e. the value of type'Scale = the number of decimal
- -- digits after the decimal point).
-@@ -3984,7 +4051,7 @@ package Einfo is
- -- This attribute uses the same field as Overridden_Operation, which is
- -- irrelevant in init_procs.
-
---- Storage_Size_Variable (Node15) [implementation base type only]
-+-- Storage_Size_Variable (Node26) [implementation base type only]
- -- Defined in access types and task type entities. This flag is set
- -- if a valid and effective pragma Storage_Size applies to the base
- -- type. Points to the entity for a variable that is created to
-@@ -4014,7 +4081,7 @@ package Einfo is
- -- to string literals in the program). Contains the length of the string
- -- literal.
-
---- String_Literal_Low_Bound (Node15)
-+-- String_Literal_Low_Bound (Node18)
- -- Defined in string literal subtypes (which are created to correspond
- -- to string literals in the program). Contains an expression whose
- -- value represents the low bound of the literal. This is a copy of
-@@ -4043,14 +4110,16 @@ package Einfo is
- -- avoid multiple elaboration warnings for the same variable.
-
- -- Suppress_Initialization (Flag105)
---- Defined in all type and subtype entities. If set for the base type,
---- then the generation of initialization procedures is suppressed for the
---- type. Any other implicit initialiation (e.g. from the use of pragma
---- Initialize_Scalars) is also suppressed if this flag is set either for
---- the subtype in question, or for the base type. Set by use of pragma
---- Suppress_Initialization and also for internal entities where we know
---- that no initialization is required. For example, enumeration image
---- table entities set it.
-+-- Defined in all variable, type and subtype entities. If set for a base
-+-- type, then the generation of initialization procedures is suppressed
-+-- for the type. Any other implicit initialiation (e.g. from the use of
-+-- pragma Initialize_Scalars) is also suppressed if this flag is set for
-+-- either the subtype in question, or for the base type. For variables,
-+-- this flag suppresses all implicit initialization for the object, even
-+-- if the type would normally require initialization. Set by use of
-+-- pragma Suppress_Initialization and also for internal entities where
-+-- we know that no initialization is required. For example, enumeration
-+-- image table entities set it.
-
- -- Suppress_Style_Checks (Flag165)
- -- Defined in all entities. Suppresses any style checks specifically
-@@ -4112,7 +4181,7 @@ package Einfo is
- -- the full view of a private type T is derived from another private type
- -- with discriminants Td, the full view of T is also private, and there
- -- is no way to attach to it a further full view that would convey the
---- structure of T to the backend. The Underlying_Full_ View is an
-+-- structure of T to the backend. The Underlying_Full_View is an
- -- attribute of the full view that is a subtype of Td with the same
- -- constraint as the declaration for T. The declaration for this subtype
- -- is built at the point of the declaration of T, either as completion,
-@@ -4443,8 +4512,8 @@ package Einfo is
- -- is created for the base type, and this is the first named subtype).
-
- E_Ordinary_Fixed_Point_Type,
-- -- Ordinary fixed type, used for the anonymous base type of the
-- -- fixed subtype created by an ordinary fixed point type declaration.
-+ -- Ordinary fixed type, used for the anonymous base type of the fixed
-+ -- subtype created by an ordinary fixed point type declaration.
-
- E_Ordinary_Fixed_Point_Subtype,
- -- Ordinary fixed point subtype, created by either an ordinary fixed
-@@ -4565,19 +4634,18 @@ package Einfo is
- -- A record subtype, created by a record subtype declaration
-
- E_Record_Type_With_Private,
-- -- Used for types defined by a private extension declaration, and
-- -- for tagged private types. Includes the fields for both private
-- -- types and for record types (with the sole exception of
-- -- Corresponding_Concurrent_Type which is obviously not needed).
-- -- This entity is considered to be both a record type and
-- -- a private type.
-+ -- Used for types defined by a private extension declaration,
-+ -- and for tagged private types. Includes the fields for both
-+ -- private types and for record types (with the sole exception of
-+ -- Corresponding_Concurrent_Type which is obviously not needed). This
-+ -- entity is considered to be both a record type and a private type.
-
- E_Record_Subtype_With_Private,
- -- A subtype of a type defined by a private extension declaration
-
- E_Private_Type,
-- -- A private type, created by a private type declaration
-- -- that has neither the keyword limited nor the keyword tagged.
-+ -- A private type, created by a private type declaration that has
-+ -- neither the keyword limited nor the keyword tagged.
-
- E_Private_Subtype,
- -- A subtype of a private type, created by a subtype declaration used
-@@ -4624,10 +4692,10 @@ package Einfo is
- -- The type of an exception created by an exception declaration
-
- E_Subprogram_Type,
-- -- This is the designated type of an Access_To_Subprogram. Has type
-- -- and signature like a subprogram entity, so can appear in calls,
-- -- which are resolved like regular calls, except that such an entity
-- -- is not overloadable.
-+ -- This is the designated type of an Access_To_Subprogram. Has type and
-+ -- signature like a subprogram entity, so can appear in calls, which
-+ -- are resolved like regular calls, except that such an entity is not
-+ -- overloadable.
-
- ---------------------------
- -- Overloadable Entities --
-@@ -4643,9 +4711,9 @@ package Einfo is
-
- E_Operator,
- -- A predefined operator, appearing in Standard, or an implicitly
-- -- defined concatenation operator created whenever an array is
-- -- declared. We do not make normal derived operators explicit in
-- -- the tree, but the concatenation operators are made explicit.
-+ -- defined concatenation operator created whenever an array is declared.
-+ -- We do not make normal derived operators explicit in the tree, but the
-+ -- concatenation operators are made explicit.
-
- E_Procedure,
- -- A procedure, created by a procedure declaration or a procedure
-@@ -5134,6 +5202,7 @@ package Einfo is
- -- Is_Bit_Packed_Array (Flag122) (base type only)
- -- Is_Aliased (Flag15)
- -- Is_Character_Type (Flag63)
-+ -- Is_Checked_Ghost_Entity (Flag277)
- -- Is_Child_Unit (Flag73)
- -- Is_Compilation_Unit (Flag149)
- -- Is_Completely_Hidden (Flag103)
-@@ -5150,6 +5219,7 @@ package Einfo is
- -- Is_Generic_Type (Flag13)
- -- Is_Hidden (Flag57)
- -- Is_Hidden_Open_Scope (Flag171)
-+ -- Is_Ignored_Ghost_Entity (Flag278)
- -- Is_Immediately_Visible (Flag7)
- -- Is_Implementation_Defined (Flag254)
- -- Is_Imported (Flag24)
-@@ -5179,7 +5249,6 @@ package Einfo is
- -- Is_Trivial_Subprogram (Flag235)
- -- Is_Unchecked_Union (Flag117)
- -- Is_Visible_Formal (Flag206)
-- -- Is_VMS_Exception (Flag133)
- -- Kill_Elaboration_Checks (Flag32)
- -- Kill_Range_Checks (Flag33)
- -- Low_Bound_Tested (Flag205)
-@@ -5205,6 +5274,7 @@ package Einfo is
- -- Has_Foreign_Convention (synth)
- -- Is_Dynamic_Scope (synth)
- -- Is_Standard_Character_Type (synth)
-+ -- Is_Standard_String_Type (synth)
- -- Underlying_Type (synth)
- -- all classification attributes (synth)
-
-@@ -5218,10 +5288,12 @@ package Einfo is
- -- Esize (Uint12)
- -- RM_Size (Uint13)
- -- Alignment (Uint14)
-+ -- Pending_Access_Types (Elist15)
- -- Related_Expression (Node24)
- -- Current_Use_Clause (Node27)
- -- Subprograms_For_Type (Node29)
- -- Derived_Type_Link (Node31)
-+ -- No_Tagged_Streams_Pragma (Node32)
- -- Linker_Section_Pragma (Node33)
-
- -- Depends_On_Private (Flag14)
-@@ -5236,11 +5308,13 @@ package Einfo is
- -- Has_Constrained_Partial_View (Flag187)
- -- Has_Controlled_Component (Flag43) (base type only)
- -- Has_Default_Aspect (Flag39) (base type only)
-+ -- Has_Default_Init_Cond (Flag3)
- -- Has_Delayed_Rep_Aspects (Flag261)
- -- Has_Discriminants (Flag5)
- -- Has_Dynamic_Predicate_Aspect (Flag258)
- -- Has_Independent_Components (Flag34) (base type only)
- -- Has_Inheritable_Invariants (Flag248)
-+ -- Has_Inherited_Default_Init_Cond (Flag133)
- -- Has_Invariants (Flag232)
- -- Has_Non_Standard_Rep (Flag75) (base type only)
- -- Has_Object_Size_Clause (Flag172)
-@@ -5270,6 +5344,7 @@ package Einfo is
- -- Is_Eliminated (Flag124)
- -- Is_Frozen (Flag4)
- -- Is_Generic_Actual_Type (Flag94)
-+ -- Is_Independent (Flag268)
- -- Is_RACW_Stub_Type (Flag244)
- -- Is_Non_Static_Subtype (Flag109)
- -- Is_Packed (Flag51) (base type only)
-@@ -5292,6 +5367,7 @@ package Einfo is
-
- -- Alignment_Clause (synth)
- -- Base_Type (synth)
-+ -- Default_Init_Cond_Procedure (synth)
- -- Implementation_Base_Type (synth)
- -- Invariant_Procedure (synth)
- -- Is_Access_Protected_Subprogram_Type (synth)
-@@ -5329,17 +5405,17 @@ package Einfo is
- -- Directly_Designated_Type (Node20)
- -- Interface_Name (Node21) (JGNAT usage only)
- -- Needs_No_Actuals (Flag22)
-- -- Original_Access_Type (Node26)
-+ -- Original_Access_Type (Node28)
- -- Can_Use_Internal_Rep (Flag229)
- -- (plus type attributes)
-
- -- E_Access_Type
- -- E_Access_Subtype
-- -- Storage_Size_Variable (Node15) (base type only)
- -- Master_Id (Node17)
- -- Directly_Designated_Type (Node20)
- -- Associated_Storage_Pool (Node22) (base type only)
- -- Finalization_Master (Node23) (base type only)
-+ -- Storage_Size_Variable (Node26) (base type only)
- -- Has_Pragma_Controlled (Flag27) (base type only)
- -- Has_Storage_Size_Clause (Flag23) (base type only)
- -- Is_Access_Constant (Flag69)
-@@ -5359,15 +5435,15 @@ package Einfo is
-
- -- E_Anonymous_Access_Subprogram_Type
- -- E_Anonymous_Access_Protected_Subprogram_Type
-- -- Storage_Size_Variable (Node15) ??? is this needed ???
- -- Directly_Designated_Type (Node20)
-+ -- Storage_Size_Variable (Node26) ??? is this needed ???
- -- Can_Use_Internal_Rep (Flag229)
- -- (plus type attributes)
-
- -- E_Anonymous_Access_Type
-- -- Storage_Size_Variable (Node15) ??? is this needed ???
- -- Directly_Designated_Type (Node20)
- -- Finalization_Master (Node23)
-+ -- Storage_Size_Variable (Node26) ??? is this needed ???
- -- (plus type attributes)
-
- -- E_Array_Type
-@@ -5396,6 +5472,7 @@ package Einfo is
- -- Last_Entity (Node20)
- -- Scope_Depth_Value (Uint22)
- -- Entry_Cancel_Parameter (Node23)
-+ -- Contains_Ignored_Ghost_Code (Flag279)
- -- Delay_Cleanups (Flag114)
- -- Discard_Names (Flag88)
- -- Has_Master_Entity (Flag21)
-@@ -5468,12 +5545,14 @@ package Einfo is
- -- Has_Atomic_Components (Flag86)
- -- Has_Biased_Representation (Flag139)
- -- Has_Completion (Flag26) (constants only)
-- -- Has_Thunks (Flag228) (constants only)
-+ -- Has_Independent_Components (Flag34)
- -- Has_Size_Clause (Flag29)
-+ -- Has_Thunks (Flag228) (constants only)
- -- Has_Up_Level_Access (Flag215)
- -- Has_Volatile_Components (Flag87)
- -- Is_Atomic (Flag85)
- -- Is_Eliminated (Flag124)
-+ -- Is_Independent (Flag268)
- -- Is_Processed_Transient (Flag252) (constants only)
- -- Is_Return_Object (Flag209)
- -- Is_True_Constant (Flag163)
-@@ -5488,7 +5567,7 @@ package Einfo is
-
- -- E_Decimal_Fixed_Point_Type
- -- E_Decimal_Fixed_Subtype
-- -- Scale_Value (Uint15)
-+ -- Scale_Value (Uint16)
- -- Digits_Value (Uint17)
- -- Scalar_Range (Node20)
- -- Delta_Value (Ureal18)
-@@ -5538,7 +5617,6 @@ package Einfo is
- -- Contract (Node34)
- -- Default_Expressions_Processed (Flag108)
- -- Entry_Accepted (Flag152)
-- -- Is_AST_Entry (Flag132) (for entry only)
- -- Needs_No_Actuals (Flag22)
- -- Sec_Stack_Needed_For_Return (Flag167)
- -- Uses_Sec_Stack (Flag95)
-@@ -5562,9 +5640,9 @@ package Einfo is
-
- -- E_Enumeration_Type
- -- E_Enumeration_Subtype
-- -- Lit_Indexes (Node15) (root type only)
- -- Lit_Strings (Node16) (root type only)
- -- First_Literal (Node17)
-+ -- Lit_Indexes (Node18) (root type only)
- -- Default_Aspect_Value (Node19) (base type only)
- -- Scalar_Range (Node20)
- -- Enum_Pos_To_Rep (Node23) (type only)
-@@ -5574,6 +5652,8 @@ package Einfo is
- -- Has_Enumeration_Rep_Clause (Flag66)
- -- Has_Pragma_Ordered (Flag198) (base type only)
- -- Nonzero_Is_True (Flag162) (base type only)
-+ -- No_Predicate_On_Actual (Flag275)
-+ -- No_Dynamic_Predicate_On_Actual (Flag276)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
-@@ -5584,9 +5664,7 @@ package Einfo is
- -- Renamed_Entity (Node18)
- -- Register_Exception_Call (Node20)
- -- Interface_Name (Node21)
-- -- Exception_Code (Uint22)
- -- Discard_Names (Flag88)
-- -- Is_VMS_Exception (Flag133)
- -- Is_Raised (Flag224)
-
- -- E_Exception_Type
-@@ -5613,7 +5691,6 @@ package Einfo is
- -- Safe_Last_Value (synth)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
-- -- Vax_Float (synth)
- -- (plus type attributes)
-
- -- E_Function
-@@ -5624,7 +5701,6 @@ package Einfo is
- -- Protected_Body_Subprogram (Node11)
- -- Next_Inlined_Subprogram (Node12)
- -- Elaboration_Entity (Node13) (not implicit /=)
-- -- First_Optional_Parameter (Node14) (non-generic case only)
- -- DT_Position (Uint15)
- -- DTC_Entity (Node16)
- -- First_Entity (Node17)
-@@ -5648,11 +5724,12 @@ package Einfo is
- -- Linker_Section_Pragma (Node33)
- -- Contract (Node34)
- -- Body_Needed_For_SAL (Flag40)
-- -- Elaboration_Entity_Required (Flag174)
-+ -- Contains_Ignored_Ghost_Code (Flag279)
- -- Default_Expressions_Processed (Flag108)
- -- Delay_Cleanups (Flag114)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Discard_Names (Flag88)
-+ -- Elaboration_Entity_Required (Flag174)
- -- Has_Anonymous_Master (Flag253)
- -- Has_Completion (Flag26)
- -- Has_Controlling_Result (Flag98)
-@@ -5669,6 +5746,9 @@ package Einfo is
- -- Is_Discrim_SO_Function (Flag176)
- -- Is_Discriminant_Check_Function (Flag264)
- -- Is_Eliminated (Flag124)
-+ -- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only)
-+ -- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only)
-+ -- Is_Inlined_Always (Flag1) (non-generic case only)
- -- Is_Instantiated (Flag126) (generic case only)
- -- Is_Intrinsic_Subprogram (Flag64)
- -- Is_Invariant_Procedure (Flag257) (non-generic case only)
-@@ -5685,24 +5765,23 @@ package Einfo is
- -- Requires_Overriding (Flag213) (non-generic case only)
- -- Return_Present (Flag54)
- -- Returns_By_Ref (Flag90)
-+ -- Returns_Limited_View (Flag134) (non-generic case only)
- -- Sec_Stack_Needed_For_Return (Flag167)
- -- SPARK_Pragma_Inherited (Flag265)
- -- Uses_Sec_Stack (Flag95)
- -- Address_Clause (synth)
- -- First_Formal (synth)
- -- First_Formal_With_Extras (synth)
-- -- Is_Ghost_Entity (synth) (non-generic case only)
-- -- Is_Ghost_Subprogram (synth) (non-generic case only)
- -- Last_Formal (synth)
- -- Number_Formals (synth)
- -- Scope_Depth (synth)
-
- -- E_General_Access_Type
-- -- Storage_Size_Variable (Node15) (base type only)
- -- Master_Id (Node17)
- -- Directly_Designated_Type (Node20)
- -- Associated_Storage_Pool (Node22) (root type only)
- -- Finalization_Master (Node23) (root type only)
-+ -- Storage_Size_Variable (Node26) (base type only)
- -- (plus type attributes)
-
- -- E_Generic_In_Parameter
-@@ -5749,7 +5828,6 @@ package Einfo is
- -- Has_Initial_Value (Flag219)
- -- Is_Controlling_Formal (Flag97)
- -- Is_Only_Out_Parameter (Flag226)
-- -- Is_Optional_Parameter (Flag134)
- -- Low_Bound_Tested (Flag205)
- -- Is_Return_Object (Flag209)
- -- Parameter_Mode (synth)
-@@ -5788,6 +5866,8 @@ package Einfo is
- -- Non_Binary_Modulus (Flag58) (base type only)
- -- Has_Biased_Representation (Flag139)
- -- Has_Shift_Operator (Flag267) (base type only)
-+ -- No_Predicate_On_Actual (Flag275)
-+ -- No_Dynamic_Predicate_On_Actual (Flag276)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
-@@ -5857,6 +5937,7 @@ package Einfo is
- -- Contract (Node34)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Body_Needed_For_SAL (Flag40)
-+ -- Contains_Ignored_Ghost_Code (Flag279)
- -- Discard_Names (Flag88)
- -- Elaboration_Entity_Required (Flag174)
- -- Elaborate_Body_Desirable (Flag210) (non-generic case only)
-@@ -5891,6 +5972,7 @@ package Einfo is
- -- SPARK_Aux_Pragma (Node33)
- -- SPARK_Pragma (Node32)
- -- Contract (Node34)
-+ -- Contains_Ignored_Ghost_Code (Flag279)
- -- Delay_Subprogram_Descriptors (Flag50)
- -- Has_Anonymous_Master (Flag253)
- -- SPARK_Aux_Pragma_Inherited (Flag266)
-@@ -5920,7 +6002,6 @@ package Einfo is
- -- Protected_Body_Subprogram (Node11)
- -- Next_Inlined_Subprogram (Node12)
- -- Elaboration_Entity (Node13)
-- -- First_Optional_Parameter (Node14) (non-generic case only)
- -- DT_Position (Uint15)
- -- DTC_Entity (Node16)
- -- First_Entity (Node17)
-@@ -5942,6 +6023,7 @@ package Einfo is
- -- Linker_Section_Pragma (Node33)
- -- Contract (Node34)
- -- Body_Needed_For_SAL (Flag40)
-+ -- Contains_Ignored_Ghost_Code (Flag279)
- -- Delay_Cleanups (Flag114)
- -- Discard_Names (Flag88)
- -- Elaboration_Entity_Required (Flag174)
-@@ -5959,7 +6041,11 @@ package Einfo is
- -- Is_Asynchronous (Flag81)
- -- Is_Called (Flag102) (non-generic case only)
- -- Is_Constructor (Flag76)
-+ -- Is_Default_Init_Cond_Procedure (Flag132) (non-generic case only)
- -- Is_Eliminated (Flag124)
-+ -- Is_Generic_Actual_Subprogram (Flag274) (non-generic case only)
-+ -- Is_Hidden_Non_Overridden_Subpgm (Flag2) (non-generic case only)
-+ -- Is_Inlined_Always (Flag1) (non-generic case only)
- -- Is_Instantiated (Flag126) (generic case only)
- -- Is_Interrupt_Handler (Flag89)
- -- Is_Intrinsic_Subprogram (Flag64)
-@@ -5984,8 +6070,6 @@ package Einfo is
- -- First_Formal (synth)
- -- First_Formal_With_Extras (synth)
- -- Is_Finalizer (synth)
-- -- Is_Ghost_Entity (synth) (non-generic case only)
-- -- Is_Ghost_Subprogram (synth) (non-generic case only)
- -- Last_Formal (synth)
- -- Number_Formals (synth)
-
-@@ -5997,10 +6081,10 @@ package Einfo is
- -- E_Protected_Type
- -- E_Protected_Subtype
- -- Direct_Primitive_Operations (Elist10)
-- -- Entry_Bodies_Array (Node15)
- -- First_Private_Entity (Node16)
- -- First_Entity (Node17)
- -- Corresponding_Record_Type (Node18)
-+ -- Entry_Bodies_Array (Node19)
- -- Last_Entity (Node20)
- -- Discriminant_Constraint (Elist21)
- -- Scope_Depth_Value (Uint22)
-@@ -6088,14 +6172,16 @@ package Einfo is
- -- Static_Discrete_Predicate (List25)
- -- Has_Biased_Representation (Flag139)
- -- Has_Shift_Operator (Flag267) (base type only)
-+ -- No_Predicate_On_Actual (Flag275)
-+ -- No_Dynamic_Predicate_On_Actual (Flag276)
- -- Type_Low_Bound (synth)
- -- Type_High_Bound (synth)
- -- (plus type attributes)
-
- -- E_String_Literal_Subtype
-- -- String_Literal_Low_Bound (Node15)
- -- String_Literal_Length (Uint16)
- -- First_Index (Node17) (always Empty)
-+ -- String_Literal_Low_Bound (Node18)
- -- Packed_Array_Impl_Type (Node23)
- -- (plus type attributes)
-
-@@ -6107,8 +6193,9 @@ package Einfo is
- -- Scope_Depth_Value (Uint22)
- -- Extra_Formals (Node28)
- -- SPARK_Pragma (Node32)
-- -- SPARK_Pragma_Inherited (Flag265)
- -- Contract (Node34)
-+ -- Contains_Ignored_Ghost_Code (Flag279)
-+ -- SPARK_Pragma_Inherited (Flag265)
- -- Scope_Depth (synth)
-
- -- E_Subprogram_Type
-@@ -6127,7 +6214,6 @@ package Einfo is
- -- E_Task_Type
- -- E_Task_Subtype
- -- Direct_Primitive_Operations (Elist10)
-- -- Storage_Size_Variable (Node15) (base type only)
- -- First_Private_Entity (Node16)
- -- First_Entity (Node17)
- -- Corresponding_Record_Type (Node18)
-@@ -6137,6 +6223,8 @@ package Einfo is
- -- Scope_Depth (synth)
- -- Stored_Constraint (Elist23)
- -- Task_Body_Procedure (Node25)
-+ -- Storage_Size_Variable (Node26) (base type only)
-+ -- Relative_Deadline_Variable (Node28) (base type only)
- -- Delay_Cleanups (Flag114)
- -- Has_Master_Entity (Flag21)
- -- Has_Storage_Size_Clause (Flag23) (base type only)
-@@ -6144,7 +6232,6 @@ package Einfo is
- -- Sec_Stack_Needed_For_Return (Flag167) ???
- -- Has_Entries (synth)
- -- Number_Entries (synth)
-- -- Relative_Deadline_Variable (Node26) (base type only)
- -- (plus type attributes)
-
- -- E_Variable
-@@ -6175,12 +6262,14 @@ package Einfo is
- -- Has_Alignment_Clause (Flag46)
- -- Has_Atomic_Components (Flag86)
- -- Has_Biased_Representation (Flag139)
-+ -- Has_Independent_Components (Flag34)
- -- Has_Initial_Value (Flag219)
- -- Has_Size_Clause (Flag29)
- -- Has_Up_Level_Access (Flag215)
- -- Has_Volatile_Components (Flag87)
- -- Is_Atomic (Flag85)
- -- Is_Eliminated (Flag124)
-+ -- Is_Independent (Flag268)
- -- Is_Processed_Transient (Flag252)
- -- Is_Safe_To_Reevaluate (Flag249)
- -- Is_Shared_Passive (Flag60)
-@@ -6190,10 +6279,10 @@ package Einfo is
- -- OK_To_Rename (Flag247)
- -- Optimize_Alignment_Space (Flag241)
- -- Optimize_Alignment_Time (Flag242)
-+ -- Suppress_Initialization (Flag105)
- -- Treat_As_Volatile (Flag41)
- -- Address_Clause (synth)
- -- Alignment_Clause (synth)
-- -- Is_Ghost_Entity (synth)
- -- Size_Clause (synth)
-
- -- E_Void
-@@ -6232,8 +6321,7 @@ package Einfo is
- -----------------------------------
-
- type Float_Rep_Kind is (
-- IEEE_Binary, -- IEEE 754p conform binary format
-- VAX_Native, -- VAX D, F, G or H format
-+ IEEE_Binary, -- IEEE 754p conforming binary format
- AAMP); -- AAMP format
-
- ---------------
-@@ -6459,6 +6547,7 @@ package Einfo is
- function Component_Clause (Id : E) return N;
- function Component_Size (Id : E) return U;
- function Component_Type (Id : E) return E;
-+ function Contains_Ignored_Ghost_Code (Id : E) return B;
- function Contract (Id : E) return N;
- function Corresponding_Concurrent_Type (Id : E) return E;
- function Corresponding_Discriminant (Id : E) return E;
-@@ -6515,7 +6604,6 @@ package Einfo is
- function Enumeration_Rep_Expr (Id : E) return N;
- function Equivalent_Type (Id : E) return E;
- function Esize (Id : E) return U;
-- function Exception_Code (Id : E) return U;
- function Extra_Accessibility (Id : E) return E;
- function Extra_Accessibility_Of_Result (Id : E) return E;
- function Extra_Constrained (Id : E) return E;
-@@ -6528,7 +6616,6 @@ package Einfo is
- function First_Exit_Statement (Id : E) return N;
- function First_Index (Id : E) return N;
- function First_Literal (Id : E) return E;
-- function First_Optional_Parameter (Id : E) return E;
- function First_Private_Entity (Id : E) return E;
- function First_Rep_Item (Id : E) return N;
- function Float_Rep (Id : E) return F;
-@@ -6554,6 +6641,7 @@ package Einfo is
- function Has_Controlling_Result (Id : E) return B;
- function Has_Convention_Pragma (Id : E) return B;
- function Has_Default_Aspect (Id : E) return B;
-+ function Has_Default_Init_Cond (Id : E) return B;
- function Has_Delayed_Aspects (Id : E) return B;
- function Has_Delayed_Freeze (Id : E) return B;
- function Has_Delayed_Rep_Aspects (Id : E) return B;
-@@ -6569,6 +6657,7 @@ package Einfo is
- function Has_Implicit_Dereference (Id : E) return B;
- function Has_Independent_Components (Id : E) return B;
- function Has_Inheritable_Invariants (Id : E) return B;
-+ function Has_Inherited_Default_Init_Cond (Id : E) return B;
- function Has_Initial_Value (Id : E) return B;
- function Has_Interrupt_Handler (Id : E) return B;
- function Has_Invariants (Id : E) return B;
-@@ -6637,7 +6726,6 @@ package Einfo is
- function Interface_Alias (Id : E) return E;
- function Interface_Name (Id : E) return N;
- function Interfaces (Id : E) return L;
-- function Is_AST_Entry (Id : E) return B;
- function Is_Abstract_Subprogram (Id : E) return B;
- function Is_Abstract_Type (Id : E) return B;
- function Is_Access_Constant (Id : E) return B;
-@@ -6650,6 +6738,7 @@ package Einfo is
- function Is_CPP_Class (Id : E) return B;
- function Is_Called (Id : E) return B;
- function Is_Character_Type (Id : E) return B;
-+ function Is_Checked_Ghost_Entity (Id : E) return B;
- function Is_Child_Unit (Id : E) return B;
- function Is_Class_Wide_Equivalent_Type (Id : E) return B;
- function Is_Compilation_Unit (Id : E) return B;
-@@ -6660,6 +6749,7 @@ package Einfo is
- function Is_Constructor (Id : E) return B;
- function Is_Controlled (Id : E) return B;
- function Is_Controlling_Formal (Id : E) return B;
-+ function Is_Default_Init_Cond_Procedure (Id : E) return B;
- function Is_Descendent_Of_Address (Id : E) return B;
- function Is_Discrim_SO_Function (Id : E) return B;
- function Is_Discriminant_Check_Function (Id : E) return B;
-@@ -6673,12 +6763,15 @@ package Einfo is
- function Is_Frozen (Id : E) return B;
- function Is_Generic_Instance (Id : E) return B;
- function Is_Hidden (Id : E) return B;
-+ function Is_Hidden_Non_Overridden_Subpgm (Id : E) return B;
- function Is_Hidden_Open_Scope (Id : E) return B;
-+ function Is_Ignored_Ghost_Entity (Id : E) return B;
- function Is_Immediately_Visible (Id : E) return B;
- function Is_Implementation_Defined (Id : E) return B;
- function Is_Imported (Id : E) return B;
- function Is_Independent (Id : E) return B;
- function Is_Inlined (Id : E) return B;
-+ function Is_Inlined_Always (Id : E) return B;
- function Is_Instantiated (Id : E) return B;
- function Is_Interface (Id : E) return B;
- function Is_Internal (Id : E) return B;
-@@ -6697,7 +6790,6 @@ package Einfo is
- function Is_Null_Init_Proc (Id : E) return B;
- function Is_Obsolescent (Id : E) return B;
- function Is_Only_Out_Parameter (Id : E) return B;
-- function Is_Optional_Parameter (Id : E) return B;
- function Is_Package_Body_Entity (Id : E) return B;
- function Is_Packed (Id : E) return B;
- function Is_Packed_Array_Impl_Type (Id : E) return B;
-@@ -6731,7 +6823,6 @@ package Einfo is
- function Is_Unchecked_Union (Id : E) return B;
- function Is_Underlying_Record_View (Id : E) return B;
- function Is_Unsigned_Type (Id : E) return B;
-- function Is_VMS_Exception (Id : E) return B;
- function Is_Valued_Procedure (Id : E) return B;
- function Is_Visible_Formal (Id : E) return B;
- function Is_Visible_Lib_Unit (Id : E) return B;
-@@ -6760,9 +6851,12 @@ package Einfo is
- function Needs_No_Actuals (Id : E) return B;
- function Never_Set_In_Source (Id : E) return B;
- function Next_Inlined_Subprogram (Id : E) return E;
-+ function No_Dynamic_Predicate_On_Actual (Id : E) return B;
- function No_Pool_Assigned (Id : E) return B;
-+ function No_Predicate_On_Actual (Id : E) return B;
- function No_Return (Id : E) return B;
- function No_Strict_Aliasing (Id : E) return B;
-+ function No_Tagged_Streams_Pragma (Id : E) return N;
- function Non_Binary_Modulus (Id : E) return B;
- function Non_Limited_View (Id : E) return E;
- function Nonzero_Is_True (Id : E) return B;
-@@ -6783,6 +6877,7 @@ package Einfo is
- function Packed_Array_Impl_Type (Id : E) return E;
- function Parent_Subtype (Id : E) return E;
- function Part_Of_Constituents (Id : E) return L;
-+ function Pending_Access_Types (Id : E) return L;
- function Postcondition_Proc (Id : E) return E;
- function Prival (Id : E) return E;
- function Prival_Link (Id : E) return E;
-@@ -6811,6 +6906,7 @@ package Einfo is
- function Return_Applies_To (Id : E) return N;
- function Return_Present (Id : E) return B;
- function Returns_By_Ref (Id : E) return B;
-+ function Returns_Limited_View (Id : E) return B;
- function Reverse_Bit_Order (Id : E) return B;
- function Reverse_Storage_Order (Id : E) return B;
- function Scalar_Range (Id : E) return N;
-@@ -6856,7 +6952,6 @@ package Einfo is
- function Used_As_Generic_Actual (Id : E) return B;
- function Uses_Lock_Free (Id : E) return B;
- function Uses_Sec_Stack (Id : E) return B;
-- function Vax_Float (Id : E) return B;
- function Warnings_Off (Id : E) return B;
- function Warnings_Off_Used (Id : E) return B;
- function Warnings_Off_Used_Unmodified (Id : E) return B;
-@@ -6897,6 +6992,7 @@ package Einfo is
- function Is_Formal (Id : E) return B;
- function Is_Formal_Object (Id : E) return B;
- function Is_Formal_Subprogram (Id : E) return B;
-+ function Is_Generic_Actual_Subprogram (Id : E) return B;
- function Is_Generic_Actual_Type (Id : E) return B;
- function Is_Generic_Unit (Id : E) return B;
- function Is_Generic_Type (Id : E) return B;
-@@ -6918,6 +7014,7 @@ package Einfo is
- function Is_Scalar_Type (Id : E) return B;
- function Is_Signed_Integer_Type (Id : E) return B;
- function Is_Subprogram (Id : E) return B;
-+ function Is_Subprogram_Or_Generic_Subprogram (Id : E) return B;
- function Is_Task_Type (Id : E) return B;
- function Is_Type (Id : E) return B;
-
-@@ -6952,8 +7049,6 @@ package Einfo is
- function Is_Dynamic_Scope (Id : E) return B;
- function Is_External_State (Id : E) return B;
- function Is_Finalizer (Id : E) return B;
-- function Is_Ghost_Entity (Id : E) return B;
-- function Is_Ghost_Subprogram (Id : E) return B;
- function Is_Null_State (Id : E) return B;
- function Is_Package_Or_Generic_Package (Id : E) return B;
- function Is_Packed_Array (Id : E) return B;
-@@ -6962,6 +7057,7 @@ package Einfo is
- function Is_Protected_Interface (Id : E) return B;
- function Is_Protected_Record_Type (Id : E) return B;
- function Is_Standard_Character_Type (Id : E) return B;
-+ function Is_Standard_String_Type (Id : E) return B;
- function Is_String_Type (Id : E) return B;
- function Is_Synchronized_Interface (Id : E) return B;
- function Is_Task_Interface (Id : E) return B;
-@@ -7094,6 +7190,7 @@ package Einfo is
- procedure Set_Component_Clause (Id : E; V : N);
- procedure Set_Component_Size (Id : E; V : U);
- procedure Set_Component_Type (Id : E; V : E);
-+ procedure Set_Contains_Ignored_Ghost_Code (Id : E; V : B := True);
- procedure Set_Contract (Id : E; V : N);
- procedure Set_Corresponding_Concurrent_Type (Id : E; V : E);
- procedure Set_Corresponding_Discriminant (Id : E; V : E);
-@@ -7149,7 +7246,6 @@ package Einfo is
- procedure Set_Enumeration_Rep_Expr (Id : E; V : N);
- procedure Set_Equivalent_Type (Id : E; V : E);
- procedure Set_Esize (Id : E; V : U);
-- procedure Set_Exception_Code (Id : E; V : U);
- procedure Set_Extra_Accessibility (Id : E; V : E);
- procedure Set_Extra_Accessibility_Of_Result (Id : E; V : E);
- procedure Set_Extra_Constrained (Id : E; V : E);
-@@ -7162,7 +7258,6 @@ package Einfo is
- procedure Set_First_Exit_Statement (Id : E; V : N);
- procedure Set_First_Index (Id : E; V : N);
- procedure Set_First_Literal (Id : E; V : E);
-- procedure Set_First_Optional_Parameter (Id : E; V : E);
- procedure Set_First_Private_Entity (Id : E; V : E);
- procedure Set_First_Rep_Item (Id : E; V : N);
- procedure Set_Float_Rep (Id : E; V : F);
-@@ -7188,6 +7283,7 @@ package Einfo is
- procedure Set_Has_Controlling_Result (Id : E; V : B := True);
- procedure Set_Has_Convention_Pragma (Id : E; V : B := True);
- procedure Set_Has_Default_Aspect (Id : E; V : B := True);
-+ procedure Set_Has_Default_Init_Cond (Id : E; V : B := True);
- procedure Set_Has_Delayed_Aspects (Id : E; V : B := True);
- procedure Set_Has_Delayed_Freeze (Id : E; V : B := True);
- procedure Set_Has_Delayed_Rep_Aspects (Id : E; V : B := True);
-@@ -7203,6 +7299,7 @@ package Einfo is
- procedure Set_Has_Implicit_Dereference (Id : E; V : B := True);
- procedure Set_Has_Independent_Components (Id : E; V : B := True);
- procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True);
-+ procedure Set_Has_Inherited_Default_Init_Cond (Id : E; V : B := True);
- procedure Set_Has_Initial_Value (Id : E; V : B := True);
- procedure Set_Has_Invariants (Id : E; V : B := True);
- procedure Set_Has_Loop_Entry_Attributes (Id : E; V : B := True);
-@@ -7270,7 +7367,6 @@ package Einfo is
- procedure Set_Interface_Alias (Id : E; V : E);
- procedure Set_Interface_Name (Id : E; V : N);
- procedure Set_Interfaces (Id : E; V : L);
-- procedure Set_Is_AST_Entry (Id : E; V : B := True);
- procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True);
- procedure Set_Is_Abstract_Type (Id : E; V : B := True);
- procedure Set_Is_Access_Constant (Id : E; V : B := True);
-@@ -7283,6 +7379,7 @@ package Einfo is
- procedure Set_Is_CPP_Class (Id : E; V : B := True);
- procedure Set_Is_Called (Id : E; V : B := True);
- procedure Set_Is_Character_Type (Id : E; V : B := True);
-+ procedure Set_Is_Checked_Ghost_Entity (Id : E; V : B := True);
- procedure Set_Is_Child_Unit (Id : E; V : B := True);
- procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True);
- procedure Set_Is_Compilation_Unit (Id : E; V : B := True);
-@@ -7294,6 +7391,7 @@ package Einfo is
- procedure Set_Is_Constructor (Id : E; V : B := True);
- procedure Set_Is_Controlled (Id : E; V : B := True);
- procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
-+ procedure Set_Is_Default_Init_Cond_Procedure (Id : E; V : B := True);
- procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True);
- procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True);
- procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True);
-@@ -7306,16 +7404,20 @@ package Einfo is
- procedure Set_Is_For_Access_Subtype (Id : E; V : B := True);
- procedure Set_Is_Formal_Subprogram (Id : E; V : B := True);
- procedure Set_Is_Frozen (Id : E; V : B := True);
-+ procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True);
- procedure Set_Is_Generic_Actual_Type (Id : E; V : B := True);
- procedure Set_Is_Generic_Instance (Id : E; V : B := True);
- procedure Set_Is_Generic_Type (Id : E; V : B := True);
- procedure Set_Is_Hidden (Id : E; V : B := True);
-+ procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True);
- procedure Set_Is_Hidden_Open_Scope (Id : E; V : B := True);
-+ procedure Set_Is_Ignored_Ghost_Entity (Id : E; V : B := True);
- procedure Set_Is_Immediately_Visible (Id : E; V : B := True);
- procedure Set_Is_Implementation_Defined (Id : E; V : B := True);
- procedure Set_Is_Imported (Id : E; V : B := True);
- procedure Set_Is_Independent (Id : E; V : B := True);
- procedure Set_Is_Inlined (Id : E; V : B := True);
-+ procedure Set_Is_Inlined_Always (Id : E; V : B := True);
- procedure Set_Is_Instantiated (Id : E; V : B := True);
- procedure Set_Is_Interface (Id : E; V : B := True);
- procedure Set_Is_Internal (Id : E; V : B := True);
-@@ -7335,7 +7437,6 @@ package Einfo is
- procedure Set_Is_Null_Init_Proc (Id : E; V : B := True);
- procedure Set_Is_Obsolescent (Id : E; V : B := True);
- procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True);
-- procedure Set_Is_Optional_Parameter (Id : E; V : B := True);
- procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
- procedure Set_Is_Packed (Id : E; V : B := True);
- procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True);
-@@ -7369,7 +7470,6 @@ package Einfo is
- procedure Set_Is_Unchecked_Union (Id : E; V : B := True);
- procedure Set_Is_Underlying_Record_View (Id : E; V : B := True);
- procedure Set_Is_Unsigned_Type (Id : E; V : B := True);
-- procedure Set_Is_VMS_Exception (Id : E; V : B := True);
- procedure Set_Is_Valued_Procedure (Id : E; V : B := True);
- procedure Set_Is_Visible_Formal (Id : E; V : B := True);
- procedure Set_Is_Visible_Lib_Unit (Id : E; V : B := True);
-@@ -7398,9 +7498,12 @@ package Einfo is
- procedure Set_Needs_No_Actuals (Id : E; V : B := True);
- procedure Set_Never_Set_In_Source (Id : E; V : B := True);
- procedure Set_Next_Inlined_Subprogram (Id : E; V : E);
-+ procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True);
- procedure Set_No_Pool_Assigned (Id : E; V : B := True);
-+ procedure Set_No_Predicate_On_Actual (Id : E; V : B := True);
- procedure Set_No_Return (Id : E; V : B := True);
- procedure Set_No_Strict_Aliasing (Id : E; V : B := True);
-+ procedure Set_No_Tagged_Streams_Pragma (Id : E; V : N);
- procedure Set_Non_Binary_Modulus (Id : E; V : B := True);
- procedure Set_Non_Limited_View (Id : E; V : E);
- procedure Set_Nonzero_Is_True (Id : E; V : B := True);
-@@ -7421,6 +7524,7 @@ package Einfo is
- procedure Set_Packed_Array_Impl_Type (Id : E; V : E);
- procedure Set_Parent_Subtype (Id : E; V : E);
- procedure Set_Part_Of_Constituents (Id : E; V : L);
-+ procedure Set_Pending_Access_Types (Id : E; V : L);
- procedure Set_Postcondition_Proc (Id : E; V : E);
- procedure Set_Prival (Id : E; V : E);
- procedure Set_Prival_Link (Id : E; V : E);
-@@ -7449,6 +7553,7 @@ package Einfo is
- procedure Set_Return_Applies_To (Id : E; V : N);
- procedure Set_Return_Present (Id : E; V : B := True);
- procedure Set_Returns_By_Ref (Id : E; V : B := True);
-+ procedure Set_Returns_Limited_View (Id : E; V : B := True);
- procedure Set_Reverse_Bit_Order (Id : E; V : B := True);
- procedure Set_Reverse_Storage_Order (Id : E; V : B := True);
- procedure Set_Scalar_Range (Id : E; V : N);
-@@ -7505,10 +7610,12 @@ package Einfo is
- -- Access to Subprograms in Subprograms_For_Type --
- ---------------------------------------------------
-
-- function Invariant_Procedure (Id : E) return N;
-- function Predicate_Function (Id : E) return N;
-- function Predicate_Function_M (Id : E) return N;
-+ function Default_Init_Cond_Procedure (Id : E) return E;
-+ function Invariant_Procedure (Id : E) return E;
-+ function Predicate_Function (Id : E) return E;
-+ function Predicate_Function_M (Id : E) return E;
-
-+ procedure Set_Default_Init_Cond_Procedure (Id : E; V : E);
- procedure Set_Invariant_Procedure (Id : E; V : E);
- procedure Set_Predicate_Function (Id : E; V : E);
- procedure Set_Predicate_Function_M (Id : E; V : E);
-@@ -7841,6 +7948,7 @@ package Einfo is
- pragma Inline (Component_Clause);
- pragma Inline (Component_Size);
- pragma Inline (Component_Type);
-+ pragma Inline (Contains_Ignored_Ghost_Code);
- pragma Inline (Contract);
- pragma Inline (Corresponding_Concurrent_Type);
- pragma Inline (Corresponding_Discriminant);
-@@ -7897,7 +8005,6 @@ package Einfo is
- pragma Inline (Enumeration_Rep_Expr);
- pragma Inline (Equivalent_Type);
- pragma Inline (Esize);
-- pragma Inline (Exception_Code);
- pragma Inline (Extra_Accessibility);
- pragma Inline (Extra_Accessibility_Of_Result);
- pragma Inline (Extra_Constrained);
-@@ -7909,7 +8016,6 @@ package Einfo is
- pragma Inline (First_Exit_Statement);
- pragma Inline (First_Index);
- pragma Inline (First_Literal);
-- pragma Inline (First_Optional_Parameter);
- pragma Inline (First_Private_Entity);
- pragma Inline (First_Rep_Item);
- pragma Inline (Freeze_Node);
-@@ -7934,6 +8040,7 @@ package Einfo is
- pragma Inline (Has_Controlling_Result);
- pragma Inline (Has_Convention_Pragma);
- pragma Inline (Has_Default_Aspect);
-+ pragma Inline (Has_Default_Init_Cond);
- pragma Inline (Has_Delayed_Aspects);
- pragma Inline (Has_Delayed_Freeze);
- pragma Inline (Has_Delayed_Rep_Aspects);
-@@ -7949,6 +8056,7 @@ package Einfo is
- pragma Inline (Has_Implicit_Dereference);
- pragma Inline (Has_Independent_Components);
- pragma Inline (Has_Inheritable_Invariants);
-+ pragma Inline (Has_Inherited_Default_Init_Cond);
- pragma Inline (Has_Initial_Value);
- pragma Inline (Has_Invariants);
- pragma Inline (Has_Loop_Entry_Attributes);
-@@ -8015,7 +8123,6 @@ package Einfo is
- pragma Inline (Interface_Alias);
- pragma Inline (Interface_Name);
- pragma Inline (Interfaces);
-- pragma Inline (Is_AST_Entry);
- pragma Inline (Is_Abstract_Subprogram);
- pragma Inline (Is_Abstract_Type);
- pragma Inline (Is_Access_Constant);
-@@ -8034,6 +8141,7 @@ package Einfo is
- pragma Inline (Is_CPP_Class);
- pragma Inline (Is_Called);
- pragma Inline (Is_Character_Type);
-+ pragma Inline (Is_Checked_Ghost_Entity);
- pragma Inline (Is_Child_Unit);
- pragma Inline (Is_Class_Wide_Equivalent_Type);
- pragma Inline (Is_Class_Wide_Type);
-@@ -8050,6 +8158,7 @@ package Einfo is
- pragma Inline (Is_Controlled);
- pragma Inline (Is_Controlling_Formal);
- pragma Inline (Is_Decimal_Fixed_Point_Type);
-+ pragma Inline (Is_Default_Init_Cond_Procedure);
- pragma Inline (Is_Descendent_Of_Address);
- pragma Inline (Is_Digits_Type);
- pragma Inline (Is_Discrete_Or_Fixed_Point_Type);
-@@ -8072,13 +8181,16 @@ package Einfo is
- pragma Inline (Is_Formal_Object);
- pragma Inline (Is_Formal_Subprogram);
- pragma Inline (Is_Frozen);
-+ pragma Inline (Is_Generic_Actual_Subprogram);
- pragma Inline (Is_Generic_Actual_Type);
- pragma Inline (Is_Generic_Instance);
- pragma Inline (Is_Generic_Subprogram);
- pragma Inline (Is_Generic_Type);
- pragma Inline (Is_Generic_Unit);
- pragma Inline (Is_Hidden);
-+ pragma Inline (Is_Hidden_Non_Overridden_Subpgm);
- pragma Inline (Is_Hidden_Open_Scope);
-+ pragma Inline (Is_Ignored_Ghost_Entity);
- pragma Inline (Is_Immediately_Visible);
- pragma Inline (Is_Implementation_Defined);
- pragma Inline (Is_Imported);
-@@ -8086,6 +8198,7 @@ package Einfo is
- pragma Inline (Is_Incomplete_Type);
- pragma Inline (Is_Independent);
- pragma Inline (Is_Inlined);
-+ pragma Inline (Is_Inlined_Always);
- pragma Inline (Is_Instantiated);
- pragma Inline (Is_Integer_Type);
- pragma Inline (Is_Interface);
-@@ -8110,7 +8223,6 @@ package Einfo is
- pragma Inline (Is_Object);
- pragma Inline (Is_Obsolescent);
- pragma Inline (Is_Only_Out_Parameter);
-- pragma Inline (Is_Optional_Parameter);
- pragma Inline (Is_Ordinary_Fixed_Point_Type);
- pragma Inline (Is_Overloadable);
- pragma Inline (Is_Package_Body_Entity);
-@@ -8155,7 +8267,6 @@ package Einfo is
- pragma Inline (Is_Unchecked_Union);
- pragma Inline (Is_Underlying_Record_View);
- pragma Inline (Is_Unsigned_Type);
-- pragma Inline (Is_VMS_Exception);
- pragma Inline (Is_Valued_Procedure);
- pragma Inline (Is_Visible_Formal);
- pragma Inline (Is_Visible_Lib_Unit);
-@@ -8185,9 +8296,12 @@ package Einfo is
- pragma Inline (Next_Index);
- pragma Inline (Next_Inlined_Subprogram);
- pragma Inline (Next_Literal);
-+ pragma Inline (No_Dynamic_Predicate_On_Actual);
- pragma Inline (No_Pool_Assigned);
-+ pragma Inline (No_Predicate_On_Actual);
- pragma Inline (No_Return);
- pragma Inline (No_Strict_Aliasing);
-+ pragma Inline (No_Tagged_Streams_Pragma);
- pragma Inline (Non_Binary_Modulus);
- pragma Inline (Non_Limited_View);
- pragma Inline (Nonzero_Is_True);
-@@ -8209,6 +8323,7 @@ package Einfo is
- pragma Inline (Parameter_Mode);
- pragma Inline (Parent_Subtype);
- pragma Inline (Part_Of_Constituents);
-+ pragma Inline (Pending_Access_Types);
- pragma Inline (Postcondition_Proc);
- pragma Inline (Prival);
- pragma Inline (Prival_Link);
-@@ -8237,6 +8352,7 @@ package Einfo is
- pragma Inline (Return_Applies_To);
- pragma Inline (Return_Present);
- pragma Inline (Returns_By_Ref);
-+ pragma Inline (Returns_Limited_View);
- pragma Inline (Reverse_Bit_Order);
- pragma Inline (Reverse_Storage_Order);
- pragma Inline (Scalar_Range);
-@@ -8323,6 +8439,7 @@ package Einfo is
- pragma Inline (Set_Component_Clause);
- pragma Inline (Set_Component_Size);
- pragma Inline (Set_Component_Type);
-+ pragma Inline (Set_Contains_Ignored_Ghost_Code);
- pragma Inline (Set_Contract);
- pragma Inline (Set_Corresponding_Concurrent_Type);
- pragma Inline (Set_Corresponding_Discriminant);
-@@ -8377,7 +8494,6 @@ package Einfo is
- pragma Inline (Set_Enumeration_Rep_Expr);
- pragma Inline (Set_Equivalent_Type);
- pragma Inline (Set_Esize);
-- pragma Inline (Set_Exception_Code);
- pragma Inline (Set_Extra_Accessibility);
- pragma Inline (Set_Extra_Accessibility_Of_Result);
- pragma Inline (Set_Extra_Constrained);
-@@ -8389,7 +8505,6 @@ package Einfo is
- pragma Inline (Set_First_Exit_Statement);
- pragma Inline (Set_First_Index);
- pragma Inline (Set_First_Literal);
-- pragma Inline (Set_First_Optional_Parameter);
- pragma Inline (Set_First_Private_Entity);
- pragma Inline (Set_First_Rep_Item);
- pragma Inline (Set_Freeze_Node);
-@@ -8414,6 +8529,7 @@ package Einfo is
- pragma Inline (Set_Has_Controlling_Result);
- pragma Inline (Set_Has_Convention_Pragma);
- pragma Inline (Set_Has_Default_Aspect);
-+ pragma Inline (Set_Has_Default_Init_Cond);
- pragma Inline (Set_Has_Delayed_Aspects);
- pragma Inline (Set_Has_Delayed_Freeze);
- pragma Inline (Set_Has_Delayed_Rep_Aspects);
-@@ -8429,6 +8545,7 @@ package Einfo is
- pragma Inline (Set_Has_Implicit_Dereference);
- pragma Inline (Set_Has_Independent_Components);
- pragma Inline (Set_Has_Inheritable_Invariants);
-+ pragma Inline (Set_Has_Inherited_Default_Init_Cond);
- pragma Inline (Set_Has_Initial_Value);
- pragma Inline (Set_Has_Invariants);
- pragma Inline (Set_Has_Loop_Entry_Attributes);
-@@ -8495,7 +8612,6 @@ package Einfo is
- pragma Inline (Set_Interface_Alias);
- pragma Inline (Set_Interface_Name);
- pragma Inline (Set_Interfaces);
-- pragma Inline (Set_Is_AST_Entry);
- pragma Inline (Set_Is_Abstract_Subprogram);
- pragma Inline (Set_Is_Abstract_Type);
- pragma Inline (Set_Is_Access_Constant);
-@@ -8508,6 +8624,7 @@ package Einfo is
- pragma Inline (Set_Is_CPP_Class);
- pragma Inline (Set_Is_Called);
- pragma Inline (Set_Is_Character_Type);
-+ pragma Inline (Set_Is_Checked_Ghost_Entity);
- pragma Inline (Set_Is_Child_Unit);
- pragma Inline (Set_Is_Class_Wide_Equivalent_Type);
- pragma Inline (Set_Is_Compilation_Unit);
-@@ -8519,6 +8636,7 @@ package Einfo is
- pragma Inline (Set_Is_Constructor);
- pragma Inline (Set_Is_Controlled);
- pragma Inline (Set_Is_Controlling_Formal);
-+ pragma Inline (Set_Is_Default_Init_Cond_Procedure);
- pragma Inline (Set_Is_Descendent_Of_Address);
- pragma Inline (Set_Is_Discrim_SO_Function);
- pragma Inline (Set_Is_Discriminant_Check_Function);
-@@ -8531,16 +8649,20 @@ package Einfo is
- pragma Inline (Set_Is_For_Access_Subtype);
- pragma Inline (Set_Is_Formal_Subprogram);
- pragma Inline (Set_Is_Frozen);
-+ pragma Inline (Set_Is_Generic_Actual_Subprogram);
- pragma Inline (Set_Is_Generic_Actual_Type);
- pragma Inline (Set_Is_Generic_Instance);
- pragma Inline (Set_Is_Generic_Type);
- pragma Inline (Set_Is_Hidden);
-+ pragma Inline (Set_Is_Hidden_Non_Overridden_Subpgm);
- pragma Inline (Set_Is_Hidden_Open_Scope);
-+ pragma Inline (Set_Is_Ignored_Ghost_Entity);
- pragma Inline (Set_Is_Immediately_Visible);
- pragma Inline (Set_Is_Implementation_Defined);
- pragma Inline (Set_Is_Imported);
- pragma Inline (Set_Is_Independent);
- pragma Inline (Set_Is_Inlined);
-+ pragma Inline (Set_Is_Inlined_Always);
- pragma Inline (Set_Is_Instantiated);
- pragma Inline (Set_Is_Interface);
- pragma Inline (Set_Is_Internal);
-@@ -8560,7 +8682,6 @@ package Einfo is
- pragma Inline (Set_Is_Null_Init_Proc);
- pragma Inline (Set_Is_Obsolescent);
- pragma Inline (Set_Is_Only_Out_Parameter);
-- pragma Inline (Set_Is_Optional_Parameter);
- pragma Inline (Set_Is_Package_Body_Entity);
- pragma Inline (Set_Is_Packed);
- pragma Inline (Set_Is_Packed_Array_Impl_Type);
-@@ -8594,7 +8715,6 @@ package Einfo is
- pragma Inline (Set_Is_Unchecked_Union);
- pragma Inline (Set_Is_Underlying_Record_View);
- pragma Inline (Set_Is_Unsigned_Type);
-- pragma Inline (Set_Is_VMS_Exception);
- pragma Inline (Set_Is_Valued_Procedure);
- pragma Inline (Set_Is_Visible_Formal);
- pragma Inline (Set_Is_Visible_Lib_Unit);
-@@ -8623,9 +8743,12 @@ package Einfo is
- pragma Inline (Set_Needs_No_Actuals);
- pragma Inline (Set_Never_Set_In_Source);
- pragma Inline (Set_Next_Inlined_Subprogram);
-+ pragma Inline (Set_No_Dynamic_Predicate_On_Actual);
- pragma Inline (Set_No_Pool_Assigned);
-+ pragma Inline (Set_No_Predicate_On_Actual);
- pragma Inline (Set_No_Return);
- pragma Inline (Set_No_Strict_Aliasing);
-+ pragma Inline (Set_No_Tagged_Streams_Pragma);
- pragma Inline (Set_Non_Binary_Modulus);
- pragma Inline (Set_Non_Limited_View);
- pragma Inline (Set_Nonzero_Is_True);
-@@ -8646,6 +8769,7 @@ package Einfo is
- pragma Inline (Set_Packed_Array_Impl_Type);
- pragma Inline (Set_Parent_Subtype);
- pragma Inline (Set_Part_Of_Constituents);
-+ pragma Inline (Set_Pending_Access_Types);
- pragma Inline (Set_Postcondition_Proc);
- pragma Inline (Set_Prival);
- pragma Inline (Set_Prival_Link);
-@@ -8674,6 +8798,7 @@ package Einfo is
- pragma Inline (Set_Return_Applies_To);
- pragma Inline (Set_Return_Present);
- pragma Inline (Set_Returns_By_Ref);
-+ pragma Inline (Set_Returns_Limited_View);
- pragma Inline (Set_Reverse_Bit_Order);
- pragma Inline (Set_Reverse_Storage_Order);
- pragma Inline (Set_Scalar_Range);
-@@ -8728,17 +8853,18 @@ package Einfo is
-
- -- END XEINFO INLINES
-
-- -- The following Inline pragmas are *not* read by xeinfo when building
-- -- the C version of this interface automatically (so the C version will
-- -- end up making out of line calls). The pragma scan in xeinfo will be
-- -- terminated on encountering the END XEINFO INLINES line. We inline
-- -- things here which are small, but not of the canonical attribute
-- -- access/set format that can be handled by xeinfo.
-+ -- The following Inline pragmas are *not* read by xeinfo when building the
-+ -- C version of this interface automatically (so the C version will end up
-+ -- making out of line calls). The pragma scan in xeinfo will be terminated
-+ -- on encountering the END XEINFO INLINES line. We inline things here which
-+ -- are small, but not of the canonical attribute access/set format that can
-+ -- be handled by xeinfo.
-
- pragma Inline (Base_Type);
- pragma Inline (Is_Base_Type);
- pragma Inline (Is_Package_Or_Generic_Package);
- pragma Inline (Is_Packed_Array);
-+ pragma Inline (Is_Subprogram_Or_Generic_Subprogram);
- pragma Inline (Is_Volatile);
- pragma Inline (Is_Wrapper_Package);
- pragma Inline (Known_RM_Size);
-diff --git a/gnat/elists.adb b/gnat/elists.adb
-index 861d3b8..fbfb9e7 100644
---- a/gnat/elists.adb
-+++ b/gnat/elists.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -138,6 +138,19 @@ package body Elists is
- end if;
- end Append_Elmt;
-
-+ ---------------------
-+ -- Append_New_Elmt --
-+ ---------------------
-+
-+ procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is
-+ begin
-+ if To = No_Elist then
-+ To := New_Elmt_List;
-+ end if;
-+
-+ Append_Elmt (N, To);
-+ end Append_New_Elmt;
-+
- ------------------------
- -- Append_Unique_Elmt --
- ------------------------
-diff --git a/gnat/elists.ads b/gnat/elists.ads
-index 2457c92..3353b9c 100644
---- a/gnat/elists.ads
-+++ b/gnat/elists.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -126,6 +126,11 @@ package Elists is
- -- Appends N at the end of To, allocating a new element. N must be a
- -- non-empty node or entity Id, and To must be an Elist (not No_Elist).
-
-+ procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id);
-+ pragma Inline (Append_New_Elmt);
-+ -- Like Append_Elmt if Elist_Id is not No_List, but if Elist_Id is No_List,
-+ -- then first assigns it an empty element list and then does the append.
-+
- procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
- -- Like Append_Elmt, except that a check is made to see if To already
- -- contains N and if so the call has no effect.
-diff --git a/gnat/err_vars.ads b/gnat/err_vars.ads
-index 6009379..48df37e 100644
---- a/gnat/err_vars.ads
-+++ b/gnat/err_vars.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -39,10 +39,10 @@ package Err_Vars is
- -- from invalid values in such cases.
-
- -- Note on error counts (Serious_Errors_Detected, Total_Errors_Detected,
-- -- Warnings_Detected). These counts might more logically appear in this
-- -- unit, but we place them in atree.ads, because of licensing issues. We
-- -- need to be able to access these counts from units that have the more
-- -- general licensing conditions.
-+ -- Warnings_Detected, Info_Messages). These counts might more logically
-+ -- appear in this unit, but we place them instead in atree.ads, because of
-+ -- licensing issues. We need to be able to access these counts from units
-+ -- that have the more general licensing conditions.
-
- ----------------------------------
- -- Error Message Mode Variables --
-@@ -93,7 +93,6 @@ package Err_Vars is
- -- are active (see errout.ads for details). If this switch is False, then
- -- these sequences are ignored (i.e. simply equivalent to a single ?). The
- -- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
-- -- Note: always ignored on VMS, where we do not provide this capability.
-
- ----------------------------------------
- -- Error Message Insertion Parameters --
-diff --git a/gnat/errout.adb b/gnat/errout.adb
-index e835ea4..bb8fb08 100644
---- a/gnat/errout.adb
-+++ b/gnat/errout.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -37,7 +37,6 @@ with Einfo; use Einfo;
- with Erroutc; use Erroutc;
- with Fname; use Fname;
- with Gnatvsn; use Gnatvsn;
--with Hostparm; use Hostparm;
- with Lib; use Lib;
- with Opt; use Opt;
- with Nlists; use Nlists;
-@@ -190,14 +189,6 @@ package body Errout is
- -- should have 'Class appended to its name (see Add_Class procedure), and
- -- is otherwise unchanged.
-
-- procedure VMS_Convert;
-- -- This procedure has no effect if called when the host is not OpenVMS. If
-- -- the host is indeed OpenVMS, then the error message stored in Msg_Buffer
-- -- is scanned for appearances of switch names which need converting to
-- -- corresponding VMS qualifier names. See Gnames/Vnames table in Errout
-- -- spec for precise definition of the conversion that is performed by this
-- -- routine in OpenVMS mode.
--
- function Warn_Insertion return String;
- -- This is called for warning messages only (so Warning_Msg_Char is set)
- -- and returns a corresponding string to use at the beginning of generated
-@@ -270,8 +261,12 @@ package body Errout is
- M.Deleted := True;
- Warnings_Detected := Warnings_Detected - 1;
-
-+ if M.Info then
-+ Info_Messages := Info_Messages - 1;
-+ end if;
-+
- if M.Warn_Err then
-- Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
-+ Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
- end if;
- end if;
-
-@@ -313,11 +308,13 @@ package body Errout is
- end if;
-
- -- If we already have messages, and we are trying to place a message at
-- -- No_Location or in package Standard, then just ignore the attempt
-- -- since we assume that what is happening is some cascaded junk. Note
-- -- that this is safe in the sense that proceeding will surely bomb.
-+ -- No_Location, then just ignore the attempt since we assume that what
-+ -- is happening is some cascaded junk. Note that this is safe in the
-+ -- sense that proceeding will surely bomb. We will also bomb if the flag
-+ -- location is No_Location and we don't have any messages so far, but
-+ -- that is a real bug and a legitimate bomb, so we go ahead.
-
-- if Flag_Location < First_Source_Ptr
-+ if Flag_Location = No_Location
- and then Total_Errors_Detected > 0
- then
- return;
-@@ -683,14 +680,22 @@ package body Errout is
- -- Error_Msg_PT --
- ------------------
-
-- procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id) is
-+ procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id) is
- begin
-- Error_Msg_NE
-- ("first formal of & must be of mode `OUT`, `IN OUT` or " &
-- "access-to-variable", Typ, Subp);
- Error_Msg_N
-- ("\in order to be overridden by protected procedure or entry " &
-- "(RM 9.4(11.9/2))", Typ);
-+ ("illegal overriding of subprogram inherited from interface", E);
-+
-+ Error_Msg_Sloc := Sloc (Iface_Prim);
-+
-+ if Ekind (E) = E_Function then
-+ Error_Msg_N
-+ ("\first formal of & declared # must be of mode `IN` "
-+ & "or access-to-constant", E);
-+ else
-+ Error_Msg_N
-+ ("\first formal of & declared # must be of mode `OUT`, `IN OUT` "
-+ & "or access-to-variable", E);
-+ end if;
- end Error_Msg_PT;
-
- -----------------
-@@ -755,12 +760,23 @@ package body Errout is
- end if;
-
- -- Set the fatal error flag in the unit table unless we are in
-- -- Try_Semantics mode. This stops the semantics from being performed
-+ -- Try_Semantics mode (in which case we set ignored mode if not
-+ -- currently set. This stops the semantics from being performed
- -- if we find a serious error. This is skipped if we are currently
- -- dealing with the configuration pragma file.
-
-- if not Try_Semantics and then Current_Source_Unit /= No_Unit then
-- Set_Fatal_Error (Get_Source_Unit (Sptr));
-+ if Current_Source_Unit /= No_Unit then
-+ declare
-+ U : constant Unit_Number_Type := Get_Source_Unit (Sptr);
-+ begin
-+ if Try_Semantics then
-+ if Fatal_Error (U) = None then
-+ Set_Fatal_Error (U, Error_Ignored);
-+ end if;
-+ else
-+ Set_Fatal_Error (U, Error_Detected);
-+ end if;
-+ end;
- end if;
- end Handle_Serious_Error;
-
-@@ -987,6 +1003,7 @@ package body Errout is
- Col => Get_Column_Number (Sptr),
- Warn => Is_Warning_Msg,
- Info => Is_Info_Msg,
-+ Check => Is_Check_Msg,
- Warn_Err => False, -- reset below
- Warn_Chr => Warning_Msg_Char,
- Style => Is_Style_Msg,
-@@ -1141,12 +1158,30 @@ package body Errout is
- if Errors.Table (Cur_Msg).Warn or else Errors.Table (Cur_Msg).Style then
- Warnings_Detected := Warnings_Detected + 1;
-
-+ if Errors.Table (Cur_Msg).Info then
-+ Info_Messages := Info_Messages + 1;
-+ end if;
-+
-+ elsif Errors.Table (Cur_Msg).Check then
-+ Check_Messages := Check_Messages + 1;
-+
- else
- Total_Errors_Detected := Total_Errors_Detected + 1;
-
- if Errors.Table (Cur_Msg).Serious then
- Serious_Errors_Detected := Serious_Errors_Detected + 1;
- Handle_Serious_Error;
-+
-+ -- If not serious error, set Fatal_Error to indicate ignored error
-+
-+ else
-+ declare
-+ U : constant Unit_Number_Type := Get_Source_Unit (Sptr);
-+ begin
-+ if Fatal_Error (U) = None then
-+ Set_Fatal_Error (U, Error_Ignored);
-+ end if;
-+ end;
- end if;
- end if;
-
-@@ -1349,8 +1384,12 @@ package body Errout is
- Errors.Table (E).Deleted := True;
- Warnings_Detected := Warnings_Detected - 1;
-
-+ if Errors.Table (E).Info then
-+ Info_Messages := Info_Messages - 1;
-+ end if;
-+
- if Errors.Table (E).Warn_Err then
-- Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
-+ Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
- end if;
- end if;
- end Delete_Warning;
-@@ -1575,6 +1614,7 @@ package body Errout is
- Total_Errors_Detected := 0;
- Warnings_Treated_As_Errors := 0;
- Warnings_Detected := 0;
-+ Info_Messages := 0;
- Warnings_As_Errors_Count := 0;
- Cur_Msg := No_Error_Msg;
- List_Pragmas.Init;
-@@ -1665,8 +1705,7 @@ package body Errout is
- begin
- -- Extra blank line if error messages or source listing were output
-
-- if Total_Errors_Detected + Warnings_Detected > 0
-- or else Full_List
-+ if Total_Errors_Detected + Warnings_Detected > 0 or else Full_List
- then
- Write_Eol;
- end if;
-@@ -1675,13 +1714,8 @@ package body Errout is
- -- This normally goes to Standard_Output. The exception is when brief
- -- mode is not set, verbose mode (or full list mode) is set, and
- -- there are errors. In this case we send the message to standard
-- -- error to make sure that *something* appears on standard error in
-- -- an error situation.
--
-- -- Formerly, only the "# errors" suffix was sent to stderr, whereas
-- -- "# lines:" appeared on stdout. This caused problems on VMS when
-- -- the stdout buffer was flushed, giving an extra line feed after
-- -- the prefix.
-+ -- error to make sure that *something* appears on standard error
-+ -- in an error situation.
-
- if Total_Errors_Detected + Warnings_Detected /= 0
- and then not Brief_Output
-@@ -1716,12 +1750,12 @@ package body Errout is
- Write_Str (" errors");
- end if;
-
-- if Warnings_Detected /= 0 then
-+ if Warnings_Detected - Info_Messages /= 0 then
- Write_Str (", ");
- Write_Int (Warnings_Detected);
- Write_Str (" warning");
-
-- if Warnings_Detected /= 1 then
-+ if Warnings_Detected - Info_Messages /= 1 then
- Write_Char ('s');
- end if;
-
-@@ -1741,6 +1775,16 @@ package body Errout is
- end if;
- end if;
-
-+ if Info_Messages /= 0 then
-+ Write_Str (", ");
-+ Write_Int (Info_Messages);
-+ Write_Str (" info message");
-+
-+ if Info_Messages > 1 then
-+ Write_Char ('s');
-+ end if;
-+ end if;
-+
- Write_Eol;
- Set_Standard_Output;
- end Write_Error_Summary;
-@@ -1761,9 +1805,11 @@ package body Errout is
- Write_Name (Full_File_Name (Sfile));
-
- if not Debug_Flag_7 then
-- Write_Str (" (source file time stamp: ");
-+ Write_Eol;
-+ Write_Str ("Source file time stamp: ");
- Write_Time_Stamp (Sfile);
-- Write_Char (')');
-+ Write_Eol;
-+ Write_Str ("Compiled at: " & Compilation_Time);
- end if;
-
- Write_Eol;
-@@ -2039,8 +2085,9 @@ package body Errout is
- Write_Max_Errors;
-
- if Warning_Mode = Treat_As_Error then
-- Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
-- Warnings_Detected := 0;
-+ Total_Errors_Detected :=
-+ Total_Errors_Detected + Warnings_Detected - Info_Messages;
-+ Warnings_Detected := Info_Messages;
- end if;
- end Output_Messages;
-
-@@ -2212,6 +2259,11 @@ package body Errout is
- and then not Errors.Table (E).Uncond
- then
- Warnings_Detected := Warnings_Detected - 1;
-+
-+ if Errors.Table (E).Info then
-+ Info_Messages := Info_Messages - 1;
-+ end if;
-+
- return True;
-
- -- No removal required
-@@ -2302,6 +2354,67 @@ package body Errout is
- end if;
- end Remove_Warning_Messages;
-
-+ ----------------------
-+ -- Adjust_Name_Case --
-+ ----------------------
-+
-+ procedure Adjust_Name_Case (Loc : Source_Ptr) is
-+ begin
-+ -- We have an all lower case name from Namet, and now we want to set
-+ -- the appropriate case. If possible we copy the actual casing from
-+ -- the source. If not we use standard identifier casing.
-+
-+ declare
-+ Src_Ind : constant Source_File_Index := Get_Source_File_Index (Loc);
-+ Sbuffer : Source_Buffer_Ptr;
-+ Ref_Ptr : Integer;
-+ Src_Ptr : Source_Ptr;
-+
-+ begin
-+ Ref_Ptr := 1;
-+ Src_Ptr := Loc;
-+
-+ -- For standard locations, always use mixed case
-+
-+ if Loc <= No_Location then
-+ Set_Casing (Mixed_Case);
-+
-+ else
-+ -- Determine if the reference we are dealing with corresponds to
-+ -- text at the point of the error reference. This will often be
-+ -- the case for simple identifier references, and is the case
-+ -- where we can copy the casing from the source.
-+
-+ Sbuffer := Source_Text (Src_Ind);
-+
-+ while Ref_Ptr <= Name_Len loop
-+ exit when
-+ Fold_Lower (Sbuffer (Src_Ptr)) /=
-+ Fold_Lower (Name_Buffer (Ref_Ptr));
-+ Ref_Ptr := Ref_Ptr + 1;
-+ Src_Ptr := Src_Ptr + 1;
-+ end loop;
-+
-+ -- If we get through the loop without a mismatch, then output the
-+ -- name the way it is cased in the source program
-+
-+ if Ref_Ptr > Name_Len then
-+ Src_Ptr := Loc;
-+
-+ for J in 1 .. Name_Len loop
-+ Name_Buffer (J) := Sbuffer (Src_Ptr);
-+ Src_Ptr := Src_Ptr + 1;
-+ end loop;
-+
-+ -- Otherwise set the casing using the default identifier casing
-+
-+ else
-+ Set_Casing (Identifier_Casing (Src_Ind), Mixed_Case);
-+ end if;
-+ end if;
-+ end;
-+ end Adjust_Name_Case;
-+
- ---------------------------
- -- Set_Identifier_Casing --
- ---------------------------
-@@ -2329,9 +2442,7 @@ package body Errout is
- -- Loop through file names to find matching one. This is a bit slow, but
- -- we only do it in error situations so it is not so terrible. Note that
- -- if the loop does not exit, then the desired case will be left set to
-- -- Mixed_Case, this can happen if the name was not in canonical form,
-- -- and gets canonicalized on VMS. Possibly we could fix this by
-- -- unconditionally canonicalizing these names ???
-+ -- Mixed_Case, this can happen if the name was not in canonical form.
-
- for J in 1 .. Last_Source_File loop
- Get_Name_String (Full_Debug_Name (J));
-@@ -2646,6 +2757,7 @@ package body Errout is
- ------------------
-
- procedure Set_Msg_Node (Node : Node_Id) is
-+ Loc : Source_Ptr;
- Ent : Entity_Id;
- Nam : Name_Id;
-
-@@ -2678,6 +2790,7 @@ package body Errout is
-
- if Nkind (Node) = N_Pragma then
- Nam := Pragma_Name (Node);
-+ Loc := Sloc (Node);
-
- -- The other cases have Chars fields, and we want to test for possible
- -- internal names, which generally represent something gone wrong. An
-@@ -2698,6 +2811,8 @@ package body Errout is
- Ent := Node;
- end if;
-
-+ Loc := Sloc (Ent);
-+
- -- If the type is the designated type of an access_to_subprogram,
- -- then there is no name to provide in the call.
-
-@@ -2715,6 +2830,7 @@ package body Errout is
-
- else
- Nam := Chars (Node);
-+ Loc := Sloc (Node);
- end if;
-
- -- At this stage, the name to output is in Nam
-@@ -2722,7 +2838,7 @@ package body Errout is
- Get_Unqualified_Decoded_Name_String (Nam);
-
- -- Remove trailing upper case letters from the name (useful for
-- -- dealing with some cases of internal names.
-+ -- dealing with some cases of internal names).
-
- while Name_Len > 1 and then Name_Buffer (Name_Len) in 'A' .. 'Z' loop
- Name_Len := Name_Len - 1;
-@@ -2738,63 +2854,9 @@ package body Errout is
- Kill_Message := True;
- end if;
-
-- -- Now we have to set the proper case. If we have a source location
-- -- then do a check to see if the name in the source is the same name
-- -- as the name in the Names table, except for possible differences
-- -- in case, which is the case when we can copy from the source.
--
-- declare
-- Src_Loc : constant Source_Ptr := Sloc (Node);
-- Sbuffer : Source_Buffer_Ptr;
-- Ref_Ptr : Integer;
-- Src_Ptr : Source_Ptr;
--
-- begin
-- Ref_Ptr := 1;
-- Src_Ptr := Src_Loc;
--
-- -- For standard locations, always use mixed case
--
-- if Src_Loc <= No_Location
-- or else Sloc (Node) <= No_Location
-- then
-- Set_Casing (Mixed_Case);
--
-- else
-- -- Determine if the reference we are dealing with corresponds to
-- -- text at the point of the error reference. This will often be
-- -- the case for simple identifier references, and is the case
-- -- where we can copy the spelling from the source.
--
-- Sbuffer := Source_Text (Get_Source_File_Index (Src_Loc));
--
-- while Ref_Ptr <= Name_Len loop
-- exit when
-- Fold_Lower (Sbuffer (Src_Ptr)) /=
-- Fold_Lower (Name_Buffer (Ref_Ptr));
-- Ref_Ptr := Ref_Ptr + 1;
-- Src_Ptr := Src_Ptr + 1;
-- end loop;
--
-- -- If we get through the loop without a mismatch, then output the
-- -- name the way it is spelled in the source program
--
-- if Ref_Ptr > Name_Len then
-- Src_Ptr := Src_Loc;
--
-- for J in 1 .. Name_Len loop
-- Name_Buffer (J) := Sbuffer (Src_Ptr);
-- Src_Ptr := Src_Ptr + 1;
-- end loop;
--
-- -- Otherwise set the casing using the default identifier casing
--
-- else
-- Set_Casing (Identifier_Casing (Flag_Source), Mixed_Case);
-- end if;
-- end if;
-- end;
-+ -- Remaining step is to adjust casing and possibly add 'Class
-
-+ Adjust_Name_Case (Loc);
- Set_Msg_Name_Buffer;
- Add_Class;
- end Set_Msg_Node;
-@@ -2978,8 +3040,6 @@ package body Errout is
- Set_Msg_Char (C);
- end case;
- end loop;
--
-- VMS_Convert;
- end Set_Msg_Text;
-
- ----------------
-@@ -3126,7 +3186,7 @@ package body Errout is
-
- procedure SPARK_Msg_N (Msg : String; N : Node_Or_Entity_Id) is
- begin
-- if SPARK_Mode = On then
-+ if SPARK_Mode /= Off then
- Error_Msg_N (Msg, N);
- end if;
- end SPARK_Msg_N;
-@@ -3141,7 +3201,7 @@ package body Errout is
- E : Node_Or_Entity_Id)
- is
- begin
-- if SPARK_Mode = On then
-+ if SPARK_Mode /= Off then
- Error_Msg_NE (Msg, N, E);
- end if;
- end SPARK_Msg_NE;
-@@ -3290,55 +3350,6 @@ package body Errout is
- end if;
- end Unwind_Internal_Type;
-
-- -----------------
-- -- VMS_Convert --
-- -----------------
--
-- procedure VMS_Convert is
-- P : Natural;
-- L : Natural;
-- N : Natural;
--
-- begin
-- if not OpenVMS then
-- return;
-- end if;
--
-- P := Msg_Buffer'First;
-- loop
-- if P >= Msglen then
-- return;
-- end if;
--
-- if Msg_Buffer (P) = '-' then
-- for G in Gnames'Range loop
-- L := Gnames (G)'Length;
--
-- -- See if we have "-ggg switch", where ggg is Gnames entry
--
-- if P + L + 7 <= Msglen
-- and then Msg_Buffer (P + 1 .. P + L) = Gnames (G).all
-- and then Msg_Buffer (P + L + 1 .. P + L + 7) = " switch"
-- then
-- -- Replace by "/vvv qualifier", where vvv is Vnames entry
--
-- N := Vnames (G)'Length;
-- Msg_Buffer (P + N + 11 .. Msglen + N - L + 3) :=
-- Msg_Buffer (P + L + 8 .. Msglen);
-- Msg_Buffer (P) := '/';
-- Msg_Buffer (P + 1 .. P + N) := Vnames (G).all;
-- Msg_Buffer (P + N + 1 .. P + N + 10) := " qualifier";
-- P := P + N + 10;
-- Msglen := Msglen + N - L + 3;
-- exit;
-- end if;
-- end loop;
-- end if;
--
-- P := P + 1;
-- end loop;
-- end VMS_Convert;
--
- --------------------
- -- Warn_Insertion --
- --------------------
-diff --git a/gnat/errout.ads b/gnat/errout.ads
-index 19931e8..d189240 100644
---- a/gnat/errout.ads
-+++ b/gnat/errout.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -413,67 +413,12 @@ package Errout is
- -- are continuations that are not printed using the -gnatj switch they
- -- will also have this prefix.
-
-- ----------------------------------------
-- -- Specialization of Messages for VMS --
-- ----------------------------------------
--
-- -- Some messages mention gcc-style switch names. When using an OpenVMS
-- -- host, such switch names must be converted to their corresponding VMS
-- -- qualifer. The following table controls this translation. In each case
-- -- the original message must contain the string "-xxx switch", where xxx
-- -- is the Gname? entry from below, and this string will be replaced by
-- -- "/yyy qualifier", where yyy is the corresponding Vname? entry.
--
-- Gname1 : aliased constant String := "fno-strict-aliasing";
-- Vname1 : aliased constant String := "OPTIMIZE=NO_STRICT_ALIASING";
--
-- Gname2 : aliased constant String := "gnatX";
-- Vname2 : aliased constant String := "EXTENSIONS_ALLOWED";
--
-- Gname3 : aliased constant String := "gnatW";
-- Vname3 : aliased constant String := "WIDE_CHARACTER_ENCODING";
--
-- Gname4 : aliased constant String := "gnatf";
-- Vname4 : aliased constant String := "REPORT_ERRORS=FULL";
--
-- Gname5 : aliased constant String := "gnat05";
-- Vname5 : aliased constant String := "05";
--
-- Gname6 : aliased constant String := "gnat2005";
-- Vname6 : aliased constant String := "2005";
--
-- Gname7 : aliased constant String := "gnat12";
-- Vname7 : aliased constant String := "12";
--
-- Gname8 : aliased constant String := "gnat2012";
-- Vname8 : aliased constant String := "2012";
--
-- Gname9 : aliased constant String := "gnateinn";
-- Vname9 : aliased constant String := "MAX_INSTANTIATIONS=nn";
--
-- type Cstring_Ptr is access constant String;
--
-- Gnames : array (Nat range <>) of Cstring_Ptr :=
-- (Gname1'Access,
-- Gname2'Access,
-- Gname3'Access,
-- Gname4'Access,
-- Gname5'Access,
-- Gname6'Access,
-- Gname7'Access,
-- Gname8'Access,
-- Gname9'Access);
--
-- Vnames : array (Nat range <>) of Cstring_Ptr :=
-- (Vname1'Access,
-- Vname2'Access,
-- Vname3'Access,
-- Vname4'Access,
-- Vname5'Access,
-- Vname6'Access,
-- Vname7'Access,
-- Vname8'Access,
-- Vname9'Access);
-+ -- Insertion sequence "low: " or "medium: " or "high: " (check message)
-+ -- This appears only at the start of the message (and not any of its
-+ -- continuations, if any), and indicates that the message is a check
-+ -- message. The message will be output with this prefix. Check
-+ -- messages are not fatal (so are like info messages in that respect)
-+ -- and are not controlled by pragma Warnings.
-
- -----------------------------------------------------
- -- Global Values Used for Error Message Insertions --
-@@ -903,9 +848,10 @@ package Errout is
- -- run-time mode or no run-time mode (as appropriate). In the former case,
- -- the name of the library is output if available.
-
-- procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id);
-- -- Posts an error on the protected type declaration Typ indicating wrong
-- -- mode of the first formal of protected type primitive Subp.
-+ procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id);
-+ -- Posts an error on protected type entry or subprogram E (referencing its
-+ -- overridden interface primitive Iface_Prim) indicating wrong mode of the
-+ -- first formal (RM 9.4(11.9/3)).
-
- procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
- -- If not operating in Ada 2012 mode, posts errors complaining that Feature
-@@ -930,28 +876,34 @@ package Errout is
-
- procedure SPARK_Msg_N (Msg : String; N : Node_Or_Entity_Id);
- pragma Inline (SPARK_Msg_N);
-- -- Same as Error_Msg_N, but the error is reported only when SPARK_Mode is
-- -- "on". The routine is inlined because it acts as a simple wrapper.
-+ -- Same as Error_Msg_N, but the error is suppressed if SPARK_Mode is Off.
-+ -- The routine is inlined because it acts as a simple wrapper.
-
- procedure SPARK_Msg_NE
- (Msg : String;
- N : Node_Or_Entity_Id;
- E : Node_Or_Entity_Id);
- pragma Inline (SPARK_Msg_NE);
-- -- Same as Error_Msg_NE, but the error is reported only when SPARK_Mode is
-- -- "on". The routine is inlined because it acts as a simple wrapper.
-+ -- Same as Error_Msg_NE, but the error is suppressed if SPARK_Mode is Off.
-+ -- The routine is inlined because it acts as a simple wrapper.
-
-- ------------------------------------
-- -- Utility Interface for Back End --
-- ------------------------------------
-+ ------------------------------------------
-+ -- Utility Interface for Casing Control --
-+ ------------------------------------------
-
-- -- The following subprograms can be used by the back end for the purposes
-- -- of concocting error messages that are not output via Errout, e.g. the
-- -- messages generated by the gcc back end.
-+ procedure Adjust_Name_Case (Loc : Source_Ptr);
-+ -- Given a name stored in Name_Buffer (1 .. Name_Len), set proper casing.
-+ -- Loc is an associated source position, if we can find a match between
-+ -- the name in Name_Buffer and the name at that source location, we copy
-+ -- the casing from the source, otherwise we set appropriate default casing.
-
- procedure Set_Identifier_Casing
- (Identifier_Name : System.Address;
- File_Name : System.Address);
-+ -- This subprogram can be used by the back end for the purposes of
-+ -- concocting error messages that are not output via Errout, e.g.
-+ -- the messages generated by the gcc back end.
-+ --
- -- The identifier is a null terminated string that represents the name of
- -- an identifier appearing in the source program. File_Name is a null
- -- terminated string giving the corresponding file name for the identifier
-diff --git a/gnat/erroutc.adb b/gnat/erroutc.adb
-index 4e5070a..32d9bbc 100644
---- a/gnat/erroutc.adb
-+++ b/gnat/erroutc.adb
-@@ -141,10 +141,12 @@ package body Erroutc is
- if Errors.Table (D).Warn or else Errors.Table (D).Style then
- Warnings_Detected := Warnings_Detected - 1;
-
-- if Errors.Table (D).Warn_Err then
-- Warnings_Treated_As_Errors :=
-- Warnings_Treated_As_Errors + 1;
-- end if;
-+ -- Note: we do not need to decrement Warnings_Treated_As_Errors
-+ -- because this only gets incremented if we actually output the
-+ -- message, which we won't do if we are deleting it here!
-+
-+ elsif Errors.Table (D).Check then
-+ Check_Messages := Check_Messages - 1;
-
- else
- Total_Errors_Detected := Total_Errors_Detected - 1;
-@@ -233,7 +235,7 @@ package body Erroutc is
- function Compilation_Errors return Boolean is
- begin
- return Total_Errors_Detected /= 0
-- or else (Warnings_Detected /= 0
-+ or else (Warnings_Detected - Info_Messages /= 0
- and then Warning_Mode = Treat_As_Error)
- or else Warnings_Treated_As_Errors /= 0;
- end Compilation_Errors;
-@@ -654,6 +656,11 @@ package body Erroutc is
- elsif Errors.Table (E).Style then
- null;
-
-+ -- No prefix needed for check message, severity is there already
-+
-+ elsif Errors.Table (E).Check then
-+ null;
-+
- -- All other cases, add "error: " if unique error tag set
-
- elsif Opt.Unique_Error_Tag then
-@@ -766,6 +773,15 @@ package body Erroutc is
- Is_Info_Msg :=
- Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "info: ";
-
-+ -- Check check message
-+
-+ Is_Check_Msg :=
-+ (Msg'Length > 8 and then Msg (Msg'First .. Msg'First + 7) = "medium: ")
-+ or else
-+ (Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "high: ")
-+ or else
-+ (Msg'Length > 5 and then Msg (Msg'First .. Msg'First + 4) = "low: ");
-+
- -- Loop through message looking for relevant insertion sequences
-
- J := Msg'First;
-@@ -834,7 +850,7 @@ package body Erroutc is
- end if;
- end loop;
-
-- if Is_Warning_Msg or Is_Style_Msg then
-+ if Is_Warning_Msg or Is_Style_Msg or Is_Check_Msg then
- Is_Serious_Error := False;
- end if;
- end Prescan_Message;
-@@ -1538,10 +1554,11 @@ package body Erroutc is
- elsif not SWE.Used
-
- -- Do not issue this warning for -Wxxx messages since the
-- -- back-end doesn't report the information.
-+ -- back-end doesn't report the information. Note that there
-+ -- is always an asterisk at the start of every message.
-
- and then not
-- (SWE.Msg'Length > 2 and then SWE.Msg (1 .. 2) = "-W")
-+ (SWE.Msg'Length > 3 and then SWE.Msg (2 .. 3) = "-W")
- then
- Eproc.all
- ("?W?no warning suppressed by this pragma", SWE.Start);
-diff --git a/gnat/erroutc.ads b/gnat/erroutc.ads
-index f23f4df..cb69f17 100644
---- a/gnat/erroutc.ads
-+++ b/gnat/erroutc.ads
-@@ -68,6 +68,10 @@ package Erroutc is
- -- "info: " and is to be treated as an information message. This string
- -- will be prepended to the message and all its continuations.
-
-+ Is_Check_Msg : Boolean := False;
-+ -- Set True to indicate that the current message starts with one of
-+ -- "high: ", "medium: ", "low: " and is to be treated as a check message.
-+
- Warning_Msg_Char : Character;
- -- Warning character, valid only if Is_Warning_Msg is True
- -- ' ' -- ? or < appeared on its own in message
-@@ -208,6 +212,9 @@ package Erroutc is
- Info : Boolean;
- -- True if info message
-
-+ Check : Boolean;
-+ -- True if check message
-+
- Warn_Err : Boolean;
- -- True if this is a warning message which is to be treated as an error
- -- as a result of a match with a Warning_As_Error pragma.
-diff --git a/gnat/errutil.adb b/gnat/errutil.adb
-index f15eec9..9fd67e1 100644
---- a/gnat/errutil.adb
-+++ b/gnat/errutil.adb
-@@ -201,24 +201,28 @@ package body Errutil is
-
- -- Otherwise build error message object for new message
-
-- Errors.Increment_Last;
-- Cur_Msg := Errors.Last;
-- Errors.Table (Cur_Msg).Text := new String'(Msg_Buffer (1 .. Msglen));
-- Errors.Table (Cur_Msg).Next := No_Error_Msg;
-- Errors.Table (Cur_Msg).Sptr := Sptr;
-- Errors.Table (Cur_Msg).Optr := Optr;
-- Errors.Table (Cur_Msg).Sfile := Get_Source_File_Index (Sptr);
-- Errors.Table (Cur_Msg).Line := Get_Physical_Line_Number (Sptr);
-- Errors.Table (Cur_Msg).Col := Get_Column_Number (Sptr);
-- Errors.Table (Cur_Msg).Style := Is_Style_Msg;
-- Errors.Table (Cur_Msg).Warn := Is_Warning_Msg;
-- Errors.Table (Cur_Msg).Info := Is_Info_Msg;
-- Errors.Table (Cur_Msg).Warn_Chr := Warning_Msg_Char;
-- Errors.Table (Cur_Msg).Serious := Is_Serious_Error;
-- Errors.Table (Cur_Msg).Uncond := Is_Unconditional_Msg;
-- Errors.Table (Cur_Msg).Msg_Cont := Continuation;
-- Errors.Table (Cur_Msg).Deleted := False;
--
-+ Errors.Append
-+ (New_Val =>
-+ (Text => new String'(Msg_Buffer (1 .. Msglen)),
-+ Next => No_Error_Msg,
-+ Prev => No_Error_Msg,
-+ Sfile => Get_Source_File_Index (Sptr),
-+ Sptr => Sptr,
-+ Optr => Optr,
-+ Line => Get_Physical_Line_Number (Sptr),
-+ Col => Get_Column_Number (Sptr),
-+ Warn => Is_Warning_Msg,
-+ Info => Is_Info_Msg,
-+ Check => Is_Check_Msg,
-+ Warn_Err => Warning_Mode = Treat_As_Error,
-+ Warn_Chr => Warning_Msg_Char,
-+ Style => Is_Style_Msg,
-+ Serious => Is_Serious_Error,
-+ Uncond => Is_Unconditional_Msg,
-+ Msg_Cont => Continuation,
-+ Deleted => False));
-+
-+ Cur_Msg := Errors.Last;
- Prev_Msg := No_Error_Msg;
- Next_Msg := First_Error_Msg;
-
-@@ -306,6 +310,13 @@ package body Errutil is
- then
- Warnings_Detected := Warnings_Detected + 1;
-
-+ if Errors.Table (Cur_Msg).Info then
-+ Info_Messages := Info_Messages + 1;
-+ end if;
-+
-+ elsif Errors.Table (Cur_Msg).Check then
-+ Check_Messages := Check_Messages + 1;
-+
- else
- Total_Errors_Detected := Total_Errors_Detected + 1;
-
-@@ -499,10 +510,10 @@ package body Errutil is
- -- error to make sure that *something* appears on standard error in
- -- an error situation.
-
-- -- Formerly, only the "# errors" suffix was sent to stderr, whereas
-- -- "# lines:" appeared on stdout. This caused problems on VMS when
-- -- the stdout buffer was flushed, giving an extra line feed after
-- -- the prefix.
-+ -- Historical note: Formerly, only the "# errors" suffix was sent
-+ -- to stderr, whereas "# lines:" appeared on stdout. This caused
-+ -- some problems on now-obsolete ports, but there seems to be no
-+ -- reason to revert this page since it would be incompatible.
-
- if Total_Errors_Detected + Warnings_Detected /= 0
- and then not Brief_Output
-@@ -533,19 +544,19 @@ package body Errutil is
- Write_Str (" errors");
- end if;
-
-- if Warnings_Detected /= 0 then
-+ if Warnings_Detected - Info_Messages /= 0 then
- Write_Str (", ");
-- Write_Int (Warnings_Detected);
-+ Write_Int (Warnings_Detected - Info_Messages);
- Write_Str (" warning");
-
-- if Warnings_Detected /= 1 then
-+ if Warnings_Detected - Info_Messages /= 1 then
- Write_Char ('s');
- end if;
-
- if Warning_Mode = Treat_As_Error then
- Write_Str (" (treated as error");
-
-- if Warnings_Detected /= 1 then
-+ if Warnings_Detected - Info_Messages /= 1 then
- Write_Char ('s');
- end if;
-
-@@ -572,8 +583,9 @@ package body Errutil is
- end if;
-
- if Warning_Mode = Treat_As_Error then
-- Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
-- Warnings_Detected := 0;
-+ Total_Errors_Detected :=
-+ Total_Errors_Detected + Warnings_Detected - Info_Messages;
-+ Warnings_Detected := Info_Messages;
- end if;
-
- -- Prevent displaying the same messages again in the future
-@@ -593,6 +605,7 @@ package body Errutil is
- Serious_Errors_Detected := 0;
- Total_Errors_Detected := 0;
- Warnings_Detected := 0;
-+ Info_Messages := 0;
- Cur_Msg := No_Error_Msg;
-
- -- Initialize warnings table, if all warnings are suppressed, supply
-@@ -772,6 +785,9 @@ package body Errutil is
- P := P - 1;
- Set_Msg_Insertion_Reserved_Word (Text, P);
-
-+ elsif C = '~' then
-+ Set_Msg_Str (Error_Msg_String (1 .. Error_Msg_Strlen));
-+
- -- Normal character with no special treatment
-
- else
-diff --git a/gnat/fname-uf.adb b/gnat/fname-uf.adb
-index e3a731f..7bf27db 100644
---- a/gnat/fname-uf.adb
-+++ b/gnat/fname-uf.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -30,7 +30,6 @@ with Krunch;
- with Opt; use Opt;
- with Osint; use Osint;
- with Table;
--with Targparm; use Targparm;
- with Uname; use Uname;
- with Widechar; use Widechar;
-
-@@ -410,8 +409,7 @@ package body Fname.UF is
- (Name_Buffer,
- Name_Len,
- Integer (Maximum_File_Name_Length),
-- Debug_Flag_4,
-- OpenVMS_On_Target);
-+ Debug_Flag_4);
-
- -- Replace extension
-
-diff --git a/gnat/fname.adb b/gnat/fname.adb
-index b4d1cb7..0bea5a0 100644
---- a/gnat/fname.adb
-+++ b/gnat/fname.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -30,9 +30,8 @@
- ------------------------------------------------------------------------------
-
- with Alloc;
--with Hostparm; use Hostparm;
- with Table;
--with Types; use Types;
-+with Types; use Types;
-
- package body Fname is
-
-@@ -78,13 +77,6 @@ package body Fname is
- then
- return True;
-
-- elsif OpenVMS
-- and then
-- (Name_Buffer (1 .. 4) = "dec-"
-- or else Name_Buffer (1 .. 8) = "dec ")
-- then
-- return True;
--
- else
- return False;
- end if;
-diff --git a/gnat/fname.ads b/gnat/fname.ads
-index 5941f52..79c84c6 100644
---- a/gnat/fname.ads
-+++ b/gnat/fname.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -83,8 +83,7 @@ package Fname is
- (Fname : File_Name_Type;
- Renamings_Included : Boolean := True) return Boolean;
- -- Similar to Is_Predefined_File_Name. The internal file set is a superset
-- -- of the predefined file set including children of GNAT, and also children
-- -- of DEC for the VMS case.
-+ -- of the predefined file set including children of GNAT.
-
- procedure Tree_Read;
- -- Dummy procedure (reads dummy table values from tree file)
-diff --git a/gnat/gnatvsn.adb b/gnat/gnatvsn.adb
-index c5a3cee..6d76f7e 100644
---- a/gnat/gnatvsn.adb
-+++ b/gnat/gnatvsn.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2007, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -46,45 +46,39 @@ package body Gnatvsn is
-
- function Gnat_Free_Software return String is
- begin
-- case Build_Type is
-- when GPL | FSF =>
-- return
-- "This is free software; see the source for copying conditions." &
-- ASCII.LF &
-- "There is NO warranty; not even for MERCHANTABILITY or FITNESS" &
-- " FOR A PARTICULAR PURPOSE.";
--
-- when Gnatpro =>
-- return
-- "This is free software; see the source for copying conditions." &
-- ASCII.LF &
-- "See your AdaCore support agreement for details of warranty" &
-- " and support." &
-- ASCII.LF &
-- "If you do not have a current support agreement, then there" &
-- " is absolutely" &
-- ASCII.LF &
-- "no warranty; not even for MERCHANTABILITY or FITNESS FOR" &
-- " A PARTICULAR" &
-- ASCII.LF &
-- "PURPOSE.";
-- end case;
-+ return
-+ "This is free software; see the source for copying conditions." &
-+ ASCII.LF &
-+ "There is NO warranty; not even for MERCHANTABILITY or FITNESS" &
-+ " FOR A PARTICULAR PURPOSE.";
- end Gnat_Free_Software;
-
-+ type char_array is array (Natural range <>) of aliased Character;
-+ Version_String : char_array (0 .. Ver_Len_Max - 1);
-+ -- Import the C string defined in the (language-independent) source file
-+ -- version.c using the zero-based convention of the C language.
-+ -- The size is not the real one, which does not matter since we will
-+ -- check for the nul character in Gnat_Version_String.
-+ pragma Import (C, Version_String, "version_string");
-+
- -------------------------
- -- Gnat_Version_String --
- -------------------------
-
- function Gnat_Version_String return String is
-+ S : String (1 .. Ver_Len_Max);
-+ Pos : Natural := 0;
- begin
-- case Build_Type is
-- when Gnatpro =>
-- return "Pro " & Gnat_Static_Version_String;
-- when GPL =>
-- return "GPL " & Gnat_Static_Version_String;
-- when FSF =>
-- return Gnat_Static_Version_String;
-- end case;
-+ loop
-+ exit when Version_String (Pos) = ASCII.NUL;
-+
-+ S (Pos + 1) := Version_String (Pos);
-+ Pos := Pos + 1;
-+
-+ exit when Pos = Ver_Len_Max;
-+ end loop;
-+
-+ return S (1 .. Pos);
- end Gnat_Version_String;
-
- end Gnatvsn;
-diff --git a/gnat/gnatvsn.ads b/gnat/gnatvsn.ads
-index f73bccb..e9b3611 100644
---- a/gnat/gnatvsn.ads
-+++ b/gnat/gnatvsn.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -34,25 +34,20 @@
-
- package Gnatvsn is
-
-- Gnat_Static_Version_String : constant String := "2014 (20140331)";
-+ Gnat_Static_Version_String : constant String := "GNU Ada";
- -- Static string identifying this version, that can be used as an argument
- -- to e.g. pragma Ident.
-- --
-- -- WARNING: some scripts rely on the format of this string. Any change
-- -- must be coordinated with the scripts requirements. Furthermore, no
-- -- other variable in this package may have a name starting with
-- -- Gnat_Static_Version.
-
- function Gnat_Version_String return String;
- -- Version output when GNAT (compiler), or its related tools, including
- -- GNATBIND, GNATCHOP, GNATFIND, GNATLINK, GNATMAKE, GNATXREF, are run
- -- (with appropriate verbose option switch set).
-
-- type Gnat_Build_Type is (Gnatpro, FSF, GPL);
-- -- See Get_Gnat_Build_Type below for the meaning of these values
-+ type Gnat_Build_Type is (FSF, GPL);
-+ -- See Build_Type below for the meaning of these values.
-
-- Build_Type : constant Gnat_Build_Type := GPL;
-- -- Kind of GNAT Build:
-+ Build_Type : constant Gnat_Build_Type := FSF;
-+ -- Kind of GNAT build:
- --
- -- FSF
- -- GNAT FSF version. This version of GNAT is part of a Free Software
-@@ -60,12 +55,6 @@ package Gnatvsn is
- -- box generated by Comperr gives information on how to report bugs
- -- and list the "no warranty" information.
- --
-- -- Gnatpro
-- -- GNAT Professional version. This version of GNAT is supported by Ada
-- -- Core Technologies. The bug box generated by package Comperr gives
-- -- instructions on bug submission that include references to customer
-- -- number, gnattracker site etc.
-- --
- -- GPL
- -- GNAT GPL Edition. This is a special version of GNAT, released by
- -- Ada Core Technologies and intended for academic users, and free
-@@ -81,7 +70,7 @@ package Gnatvsn is
- -- Return the name of the Copyright holder to be displayed by the different
- -- GNAT tools when switch --version is used.
-
-- Ver_Len_Max : constant := 64;
-+ Ver_Len_Max : constant := 256;
- -- Longest possible length for Gnat_Version_String in this or any
- -- other version of GNAT. This is used by the binder to establish
- -- space to store any possible version string value for checks. This
-@@ -93,7 +82,7 @@ package Gnatvsn is
- -- Prefix generated by binder. If it is changed, be sure to change
- -- GNAT.Compiler_Version.Ver_Prefix as well.
-
-- Library_Version : constant String := "2014";
-+ Library_Version : constant String := "5";
- -- Library version. This value must be updated when the compiler
- -- version number Gnat_Static_Version_String is updated.
- --
-@@ -103,7 +92,7 @@ package Gnatvsn is
- Verbose_Library_Version : constant String := "GNAT Lib v" & Library_Version;
- -- Version string stored in e.g. ALI files
-
-- Current_Year : constant String := "2014";
-+ Current_Year : constant String := "2015";
- -- Used in printing copyright messages
-
- end Gnatvsn;
-diff --git a/gnat/hostparm.ads b/gnat/hostparm.ads
-index 814ae07..253c3be 100644
---- a/gnat/hostparm.ads
-+++ b/gnat/hostparm.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -41,11 +41,6 @@ package Hostparm is
- -- HOST Parameters --
- ---------------------
-
-- OpenVMS : Boolean := False;
-- -- Set True for OpenVMS host. See also OpenVMS target boolean in
-- -- system-vms.ads and system-vms_64.ads and OpenVMS_On_Target boolean in
-- -- Targparm. This is not a constant, because it can be modified by -gnatdm.
--
- Direct_Separator : constant Character;
- pragma Import (C, Direct_Separator, "__gnat_dir_separator");
- Normalized_CWD : constant String := "." & Direct_Separator;
-@@ -75,9 +70,4 @@ package Hostparm is
- -- If set to true, gnatbind will exclude from consideration all
- -- non-existent .o files.
-
-- Max_Debug_Name_Length : constant := 256;
-- -- If a generated qualified debug name exceeds this length, then it
-- -- is automatically compressed, regardless of the setting of the
-- -- Compress_Debug_Names switch controlled by -gnatC.
--
- end Hostparm;
-diff --git a/gnat/krunch.adb b/gnat/krunch.adb
-index 2ae9ea3..79f9de1 100644
---- a/gnat/krunch.adb
-+++ b/gnat/krunch.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -29,15 +29,11 @@
- -- --
- ------------------------------------------------------------------------------
-
--with Hostparm;
--
- procedure Krunch
- (Buffer : in out String;
- Len : in out Natural;
- Maxlen : Natural;
-- No_Predef : Boolean;
-- VMS_On_Target : Boolean := False)
--
-+ No_Predef : Boolean)
- is
- pragma Assert (Buffer'First = 1);
- -- This is a documented requirement; the assert turns off index warnings
-@@ -120,36 +116,15 @@ begin
- -- Special case of a child unit whose parent unit is a single letter that
- -- is A, G, I, or S. In order to prevent confusion with krunched names
- -- of predefined units use a tilde rather than a minus as the second
-- -- character of the file name. On VMS a tilde is an illegal character
-- -- in a file name, two consecutive underlines ("__") are used instead.
-+ -- character of the file name.
-
- elsif Len > 1
- and then Buffer (2) = '-'
- and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
- and then Len <= Maxlen
- then
-- -- When VMS is the host, it is always also the target
--
-- if Hostparm.OpenVMS or else VMS_On_Target then
-- Len := Len + 1;
-- Buffer (4 .. Len) := Buffer (3 .. Len - 1);
-- Buffer (2) := '_';
-- Buffer (3) := '_';
-- else
-- Buffer (2) := '~';
-- end if;
--
-- if Len <= Maxlen then
-- return;
--
-- else
-- -- Case of VMS when the buffer had exactly the length Maxlen and now
-- -- has the length Maxlen + 1: krunching after "__" is needed.
--
-- Startloc := 4;
-- Curlen := Len;
-- Krlen := Maxlen;
-- end if;
-+ Buffer (2) := '~';
-+ return;
-
- -- Normal case, not a predefined file
-
-@@ -261,5 +236,4 @@ begin
- end loop;
-
- return;
--
- end Krunch;
-diff --git a/gnat/krunch.ads b/gnat/krunch.ads
-index dd4c6f9..7cfb637 100644
---- a/gnat/krunch.ads
-+++ b/gnat/krunch.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -121,8 +121,7 @@ procedure Krunch
- (Buffer : in out String;
- Len : in out Natural;
- Maxlen : Natural;
-- No_Predef : Boolean;
-- VMS_On_Target : Boolean := False);
-+ No_Predef : Boolean);
- pragma Elaborate_Body (Krunch);
- -- The full file name is stored in Buffer (1 .. Len) on entry. The file
- -- name is crunched in place and on return Len is updated, so that the
-@@ -131,8 +130,6 @@ pragma Elaborate_Body (Krunch);
- -- case it may be possible that Krunch does not modify Buffer. The fourth
- -- parameter, No_Predef, is a switch which, if set to True, disables the
- -- normal special treatment of predefined library unit file names.
---- VMS_On_Target, when True, indicates to Krunch to apply the VMS treatment
---- to the children of package A, G,I or S.
- --
- -- Note: the string Buffer must have a lower bound of 1, and may not
- -- contain any blanks (in particular, it must not have leading blanks).
-diff --git a/gnat/lib-list.adb b/gnat/lib-list.adb
-index bd4e402..831dc90 100644
---- a/gnat/lib-list.adb
-+++ b/gnat/lib-list.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/lib-sort.adb b/gnat/lib-sort.adb
-index 4a266b6..7bc155b 100644
---- a/gnat/lib-sort.adb
-+++ b/gnat/lib-sort.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/lib.adb b/gnat/lib.adb
-index 0e25a7c..08866b2 100644
---- a/gnat/lib.adb
-+++ b/gnat/lib.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -106,7 +106,7 @@ package body Lib is
- return Units.Table (U).Expected_Unit;
- end Expected_Unit;
-
-- function Fatal_Error (U : Unit_Number_Type) return Boolean is
-+ function Fatal_Error (U : Unit_Number_Type) return Fatal_Type is
- begin
- return Units.Table (U).Fatal_Error;
- end Fatal_Error;
-@@ -146,6 +146,11 @@ package body Lib is
- return Units.Table (U).Munit_Index;
- end Munit_Index;
-
-+ function No_Elab_Code_All (U : Unit_Number_Type) return Boolean is
-+ begin
-+ return Units.Table (U).No_Elab_Code_All;
-+ end No_Elab_Code_All;
-+
- function OA_Setting (U : Unit_Number_Type) return Character is
- begin
- return Units.Table (U).OA_Setting;
-@@ -191,9 +196,9 @@ package body Lib is
- Units.Table (U).Error_Location := W;
- end Set_Error_Location;
-
-- procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True) is
-+ procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type) is
- begin
-- Units.Table (U).Fatal_Error := B;
-+ Units.Table (U).Fatal_Error := V;
- end Set_Fatal_Error;
-
- procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is
-@@ -226,6 +231,14 @@ package body Lib is
- Units.Table (U).Main_Priority := P;
- end Set_Main_Priority;
-
-+ procedure Set_No_Elab_Code_All
-+ (U : Unit_Number_Type;
-+ B : Boolean := True)
-+ is
-+ begin
-+ Units.Table (U).No_Elab_Code_All := B;
-+ end Set_No_Elab_Code_All;
-+
- procedure Set_OA_Setting (U : Unit_Number_Type; C : Character) is
- begin
- Units.Table (U).OA_Setting := C;
-@@ -1046,8 +1059,17 @@ package body Lib is
- ----------------
-
- procedure Store_Note (N : Node_Id) is
-+ Sfile : constant Source_File_Index := Get_Source_File_Index (Sloc (N));
-+
- begin
-- Notes.Append ((Pragma_Node => N, Unit => Current_Sem_Unit));
-+ -- Notes for a generic are emitted when processing the template, never
-+ -- in instances.
-+
-+ if In_Extended_Main_Code_Unit (N)
-+ and then Instance (Sfile) = No_Instance_Id
-+ then
-+ Notes.Append (N);
-+ end if;
- end Store_Note;
-
- -------------------------------
-diff --git a/gnat/lib.ads b/gnat/lib.ads
-index 8f081a6..4e9471c 100644
---- a/gnat/lib.ads
-+++ b/gnat/lib.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -302,7 +302,7 @@ package Lib is
- -- No_Name for the main unit.
-
- -- Fatal_Error
-- -- A flag that is initialized to False, and gets set to True if a fatal
-+ -- A flag that is initialized to None and gets set to Errorif a fatal
- -- error occurs during the processing of a unit. A fatal error is one
- -- defined as serious enough to stop the next phase of the compiler
- -- from running (i.e. fatal error during parsing stops semantics,
-@@ -310,6 +310,7 @@ package Lib is
- -- currently, errors of any kind cause Fatal_Error to be set, but
- -- eventually perhaps only errors labeled as fatal errors should be
- -- this severe if we decide to try Sem on sources with minor errors.
-+ -- There are three settings (see declaration of Fatal_Type).
-
- -- Generate_Code
- -- This flag is set True for all units in the current file for which
-@@ -347,6 +348,11 @@ package Lib is
- -- The index of the unit within the file for multiple unit per file
- -- mode. Set to zero in normal single unit per file mode.
-
-+ -- No_Elab_Code_All
-+ -- A flag set when a pragma or aspect No_Elaboration_Code_All applies
-+ -- to the unit. This is used to implement the transitive WITH rules
-+ -- (and for no other purpose).
-+
- -- OA_Setting
- -- This is a character field containing L if Optimize_Alignment mode
- -- was set locally, and O/T/S for Off/Time/Space default if not.
-@@ -396,13 +402,29 @@ package Lib is
- Default_Main_CPU : constant Int := -1;
- -- Value used in Main_CPU field to indicate default main affinity
-
-+ -- The following defines settings for the Fatal_Error field
-+
-+ type Fatal_Type is (
-+ None,
-+ -- No error detected for this unit
-+
-+ Error_Detected,
-+ -- Fatal error detected that prevents moving to the next phase. For
-+ -- example, a fatal error during parsing inhibits semantic analysis.
-+
-+ Error_Ignored);
-+ -- A fatal error was detected, but we are in Try_Semantics mode (as set
-+ -- by -gnatq or -gnatQ). This does not stop the compiler from proceding,
-+ -- but tools can use this status (e.g. ASIS looking at the generated
-+ -- tree) to know that a fatal error was detected.
-+
- function Cunit (U : Unit_Number_Type) return Node_Id;
- function Cunit_Entity (U : Unit_Number_Type) return Entity_Id;
- function Dependency_Num (U : Unit_Number_Type) return Nat;
- function Dynamic_Elab (U : Unit_Number_Type) return Boolean;
- function Error_Location (U : Unit_Number_Type) return Source_Ptr;
- function Expected_Unit (U : Unit_Number_Type) return Unit_Name_Type;
-- function Fatal_Error (U : Unit_Number_Type) return Boolean;
-+ function Fatal_Error (U : Unit_Number_Type) return Fatal_Type;
- function Generate_Code (U : Unit_Number_Type) return Boolean;
- function Ident_String (U : Unit_Number_Type) return Node_Id;
- function Has_RACW (U : Unit_Number_Type) return Boolean;
-@@ -410,41 +432,50 @@ package Lib is
- function Main_CPU (U : Unit_Number_Type) return Int;
- function Main_Priority (U : Unit_Number_Type) return Int;
- function Munit_Index (U : Unit_Number_Type) return Nat;
-+ function No_Elab_Code_All (U : Unit_Number_Type) return Boolean;
- function OA_Setting (U : Unit_Number_Type) return Character;
- function Source_Index (U : Unit_Number_Type) return Source_File_Index;
- function Unit_File_Name (U : Unit_Number_Type) return File_Name_Type;
- function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type;
- -- Get value of named field from given units table entry
-
-- procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
-- procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
-- procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
-- procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
-- procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True);
-- procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
-- procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
-- procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
-- procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
-- procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
-- procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
-- procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
-- procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
-+ procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id);
-+ procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id);
-+ procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True);
-+ procedure Set_Error_Location (U : Unit_Number_Type; W : Source_Ptr);
-+ procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type);
-+ procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True);
-+ procedure Set_Has_RACW (U : Unit_Number_Type; B : Boolean := True);
-+ procedure Set_Ident_String (U : Unit_Number_Type; N : Node_Id);
-+ procedure Set_Loading (U : Unit_Number_Type; B : Boolean := True);
-+ procedure Set_Main_CPU (U : Unit_Number_Type; P : Int);
-+ procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
-+ procedure Set_Main_Priority (U : Unit_Number_Type; P : Int);
-+ procedure Set_OA_Setting (U : Unit_Number_Type; C : Character);
-+ procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
- -- Set value of named field for given units table entry. Note that we
- -- do not have an entry for each possible field, since some of the fields
- -- can only be set by specialized interfaces (defined below).
-
-- function Version_Get (U : Unit_Number_Type) return Word_Hex_String;
-- -- Returns the version as a string with 8 hex digits (upper case letters)
-+ function Compilation_Switches_Last return Nat;
-+ -- Return the count of stored compilation switches
-
-- function Last_Unit return Unit_Number_Type;
-- -- Unit number of last allocated unit
-+ procedure Disable_Switch_Storing;
-+ -- Disable registration of switches by Store_Compilation_Switch. Used to
-+ -- avoid registering switches added automatically by the gcc driver at the
-+ -- end of the command line.
-
-- function Num_Units return Nat;
-- -- Number of units currently in unit table
-+ function Earlier_In_Extended_Unit (S1, S2 : Source_Ptr) return Boolean;
-+ -- Given two Sloc values for which In_Same_Extended_Unit is true, determine
-+ -- if S1 appears before S2. Returns True if S1 appears before S2, and False
-+ -- otherwise. The result is undefined if S1 and S2 are not in the same
-+ -- extended unit. Note: this routine will not give reliable results if
-+ -- called after Sprint has been called with -gnatD set.
-
-- procedure Remove_Unit (U : Unit_Number_Type);
-- -- Remove unit U from unit table. Currently this is effective only
-- -- if U is the last unit currently stored in the unit table.
-+ procedure Enable_Switch_Storing;
-+ -- Enable registration of switches by Store_Compilation_Switch. Used to
-+ -- avoid registering switches added automatically by the gcc driver at the
-+ -- beginning of the command line.
-
- function Entity_Is_In_Main_Unit (E : Entity_Id) return Boolean;
- -- Returns True if the entity E is declared in the main unit, or, in
-@@ -452,6 +483,45 @@ package Lib is
- -- within generic instantiations return True if the instantiation is
- -- itself "in the main unit" by this definition. Otherwise False.
-
-+ function Exact_Source_Name (Loc : Source_Ptr) return String;
-+ -- Return name of entity at location Loc exactly as written in the source.
-+ -- this includes copying the wide character encodings exactly as they were
-+ -- used in the source, so the caller must be aware of the possibility of
-+ -- such encodings.
-+
-+ function Get_Compilation_Switch (N : Pos) return String_Ptr;
-+ -- Return the Nth stored compilation switch, or null if less than N
-+ -- switches have been stored. Used by ASIS and back ends written in Ada.
-+
-+ function Generic_May_Lack_ALI (Sfile : File_Name_Type) return Boolean;
-+ -- Generic units must be separately compiled. Since we always use
-+ -- macro substitution for generics, the resulting object file is a dummy
-+ -- one with no code, but the ALI file has the normal form, and we need
-+ -- this ALI file so that the binder can work out a correct order of
-+ -- elaboration.
-+ --
-+ -- However, ancient versions of GNAT used to not generate code or ALI
-+ -- files for generic units, and this would yield complex order of
-+ -- elaboration issues. These were fixed in GNAT 3.10. The support for not
-+ -- compiling language-defined library generics was retained nonetheless
-+ -- to facilitate bootstrap. Specifically, it is convenient to have
-+ -- the same list of files to be compiled for all stages. So, if the
-+ -- bootstrap compiler does not generate code for a given file, then
-+ -- the stage1 compiler (and binder) also must deal with the case of
-+ -- that file not being compiled. The predicate Generic_May_Lack_ALI is
-+ -- True for those generic units for which missing ALI files are allowed.
-+
-+ function Get_Cunit_Unit_Number (N : Node_Id) return Unit_Number_Type;
-+ -- Return unit number of the unit whose N_Compilation_Unit node is the
-+ -- one passed as an argument. This must always succeed since the node
-+ -- could not have been built without making a unit table entry.
-+
-+ function Get_Cunit_Entity_Unit_Number
-+ (E : Entity_Id) return Unit_Number_Type;
-+ -- Return unit number of the unit whose compilation unit spec entity is
-+ -- the one passed as an argument. This must always succeed since the
-+ -- entity could not have been built without making a unit table entry.
-+
- function Get_Source_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type;
- pragma Inline (Get_Source_Unit);
- function Get_Source_Unit (S : Source_Ptr) return Unit_Number_Type;
-@@ -471,34 +541,6 @@ package Lib is
- -- template, so it returns the unit number containing the code that
- -- corresponds to the node N, or the source location S.
-
-- function In_Same_Source_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
-- pragma Inline (In_Same_Source_Unit);
-- -- Determines if the two nodes or entities N1 and N2 are in the same
-- -- source unit, the criterion being that Get_Source_Unit yields the
-- -- same value for each argument.
--
-- function In_Same_Code_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
-- pragma Inline (In_Same_Code_Unit);
-- -- Determines if the two nodes or entities N1 and N2 are in the same
-- -- code unit, the criterion being that Get_Code_Unit yields the same
-- -- value for each argument.
--
-- function In_Same_Extended_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
-- pragma Inline (In_Same_Extended_Unit);
-- -- Determines if two nodes or entities N1 and N2 are in the same
-- -- extended unit, where an extended unit is defined as a unit and all
-- -- its subunits (considered recursively, i.e. subunits of subunits are
-- -- included). Returns true if S1 and S2 are in the same extended unit
-- -- and False otherwise.
--
-- function In_Same_Extended_Unit (S1, S2 : Source_Ptr) return Boolean;
-- pragma Inline (In_Same_Extended_Unit);
-- -- Determines if the two source locations S1 and S2 are in the same
-- -- extended unit, where an extended unit is defined as a unit and all
-- -- its subunits (considered recursively, i.e. subunits of subunits are
-- -- included). Returns true if S1 and S2 are in the same extended unit
-- -- and False otherwise.
--
- function In_Extended_Main_Code_Unit
- (N : Node_Or_Entity_Id) return Boolean;
- -- Return True if the node is in the generated code of the extended main
-@@ -543,48 +585,67 @@ package Lib is
- function In_Predefined_Unit (S : Source_Ptr) return Boolean;
- -- Same function as above but argument is a source pointer
-
-- function Earlier_In_Extended_Unit (S1, S2 : Source_Ptr) return Boolean;
-- -- Given two Sloc values for which In_Same_Extended_Unit is true, determine
-- -- if S1 appears before S2. Returns True if S1 appears before S2, and False
-- -- otherwise. The result is undefined if S1 and S2 are not in the same
-- -- extended unit. Note: this routine will not give reliable results if
-- -- called after Sprint has been called with -gnatD set.
--
-- function Exact_Source_Name (Loc : Source_Ptr) return String;
-- -- Return name of entity at location Loc exactly as written in the source.
-- -- this includes copying the wide character encodings exactly as they were
-- -- used in the source, so the caller must be aware of the possibility of
-- -- such encodings.
--
-- function Compilation_Switches_Last return Nat;
-- -- Return the count of stored compilation switches
-+ function In_Same_Code_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
-+ pragma Inline (In_Same_Code_Unit);
-+ -- Determines if the two nodes or entities N1 and N2 are in the same
-+ -- code unit, the criterion being that Get_Code_Unit yields the same
-+ -- value for each argument.
-
-- function Get_Compilation_Switch (N : Pos) return String_Ptr;
-- -- Return the Nth stored compilation switch, or null if less than N
-- -- switches have been stored. Used by ASIS and back ends written in Ada.
-+ function In_Same_Extended_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
-+ pragma Inline (In_Same_Extended_Unit);
-+ -- Determines if two nodes or entities N1 and N2 are in the same
-+ -- extended unit, where an extended unit is defined as a unit and all
-+ -- its subunits (considered recursively, i.e. subunits of subunits are
-+ -- included). Returns true if S1 and S2 are in the same extended unit
-+ -- and False otherwise.
-
-- function Get_Cunit_Unit_Number (N : Node_Id) return Unit_Number_Type;
-- -- Return unit number of the unit whose N_Compilation_Unit node is the
-- -- one passed as an argument. This must always succeed since the node
-- -- could not have been built without making a unit table entry.
-+ function In_Same_Extended_Unit (S1, S2 : Source_Ptr) return Boolean;
-+ pragma Inline (In_Same_Extended_Unit);
-+ -- Determines if the two source locations S1 and S2 are in the same
-+ -- extended unit, where an extended unit is defined as a unit and all
-+ -- its subunits (considered recursively, i.e. subunits of subunits are
-+ -- included). Returns true if S1 and S2 are in the same extended unit
-+ -- and False otherwise.
-
-- function Get_Cunit_Entity_Unit_Number
-- (E : Entity_Id) return Unit_Number_Type;
-- -- Return unit number of the unit whose compilation unit spec entity is
-- -- the one passed as an argument. This must always succeed since the
-- -- entity could not have been built without making a unit table entry.
-+ function In_Same_Source_Unit (N1, N2 : Node_Or_Entity_Id) return Boolean;
-+ pragma Inline (In_Same_Source_Unit);
-+ -- Determines if the two nodes or entities N1 and N2 are in the same
-+ -- source unit, the criterion being that Get_Source_Unit yields the
-+ -- same value for each argument.
-
- function Increment_Serial_Number return Nat;
- -- Increment Serial_Number field for current unit, and return the
- -- incremented value.
-
-- procedure Synchronize_Serial_Number;
-- -- This function increments the Serial_Number field for the current unit
-- -- but does not return the incremented value. This is used when there
-- -- is a situation where one path of control increments a serial number
-- -- (using Increment_Serial_Number), and the other path does not and it is
-- -- important to keep the serial numbers synchronized in the two cases (e.g.
-- -- when the references in a package and a client must be kept consistent).
-+ procedure Initialize;
-+ -- Initialize internal tables
-+
-+ function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
-+ -- Determines if unit with given name is already loaded, i.e. there is
-+ -- already an entry in the file table with this unit name for which the
-+ -- corresponding file was found and parsed. Note that the Fatal_Error value
-+ -- of this entry must be checked before proceeding with further processing.
-+
-+ function Last_Unit return Unit_Number_Type;
-+ -- Unit number of last allocated unit
-+
-+ procedure List (File_Names_Only : Boolean := False);
-+ -- Lists units in active library (i.e. generates output consisting of a
-+ -- sorted listing of the units represented in File table, except for the
-+ -- main unit). If File_Names_Only is set to True, then the list includes
-+ -- only file names, and no other information. Otherwise the unit name and
-+ -- time stamp are also output. File_Names_Only also restricts the list to
-+ -- exclude any predefined files.
-+
-+ procedure Lock;
-+ -- Lock internal tables before calling back end
-+
-+ function Num_Units return Nat;
-+ -- Number of units currently in unit table
-+
-+ procedure Remove_Unit (U : Unit_Number_Type);
-+ -- Remove unit U from unit table. Currently this is effective only if U is
-+ -- the last unit currently stored in the unit table.
-
- procedure Replace_Linker_Option_String
- (S : String_Id;
-@@ -597,16 +658,6 @@ package Lib is
- -- which may influence the generated output file(s). Switch is the text of
- -- the switch to store (except that -fRTS gets changed back to --RTS).
-
-- procedure Enable_Switch_Storing;
-- -- Enable registration of switches by Store_Compilation_Switch. Used to
-- -- avoid registering switches added automatically by the gcc driver at the
-- -- beginning of the command line.
--
-- procedure Disable_Switch_Storing;
-- -- Disable registration of switches by Store_Compilation_Switch. Used to
-- -- avoid registering switches added automatically by the gcc driver at the
-- -- end of the command line.
--
- procedure Store_Linker_Option_String (S : String_Id);
- -- This procedure is called to register the string from a pragma
- -- Linker_Option. The argument is the Id of the string to register.
-@@ -615,14 +666,13 @@ package Lib is
- -- This procedure is called to register a pragma N for which a notes
- -- entry is required.
-
-- procedure Initialize;
-- -- Initialize internal tables
--
-- procedure Lock;
-- -- Lock internal tables before calling back end
--
-- procedure Unlock;
-- -- Unlock internal tables, in cases where the back end needs to modify them
-+ procedure Synchronize_Serial_Number;
-+ -- This function increments the Serial_Number field for the current unit
-+ -- but does not return the incremented value. This is used when there
-+ -- is a situation where one path of control increments a serial number
-+ -- (using Increment_Serial_Number), and the other path does not and it is
-+ -- important to keep the serial numbers synchronized in the two cases (e.g.
-+ -- when the references in a package and a client must be kept consistent).
-
- procedure Tree_Read;
- -- Initializes internal tables from current tree file using the relevant
-@@ -632,43 +682,17 @@ package Lib is
- -- Writes out internal tables to current tree file using the relevant
- -- Table.Tree_Write routines.
-
-- function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
-- -- Determines if unit with given name is already loaded, i.e. there is
-- -- already an entry in the file table with this unit name for which the
-- -- corresponding file was found and parsed. Note that the Fatal_Error flag
-- -- of this entry must be checked before proceeding with further processing.
-+ procedure Unlock;
-+ -- Unlock internal tables, in cases where the back end needs to modify them
-+
-+ function Version_Get (U : Unit_Number_Type) return Word_Hex_String;
-+ -- Returns the version as a string with 8 hex digits (upper case letters)
-
- procedure Version_Referenced (S : String_Id);
- -- This routine is called from Exp_Attr to register the use of a Version
- -- or Body_Version attribute. The argument is the external name used to
- -- access the version string.
-
-- procedure List (File_Names_Only : Boolean := False);
-- -- Lists units in active library (i.e. generates output consisting of a
-- -- sorted listing of the units represented in File table, except for the
-- -- main unit). If File_Names_Only is set to True, then the list includes
-- -- only file names, and no other information. Otherwise the unit name and
-- -- time stamp are also output. File_Names_Only also restricts the list to
-- -- exclude any predefined files.
--
-- function Generic_May_Lack_ALI (Sfile : File_Name_Type) return Boolean;
-- -- Generic units must be separately compiled. Since we always use
-- -- macro substitution for generics, the resulting object file is a dummy
-- -- one with no code, but the ALI file has the normal form, and we need
-- -- this ALI file so that the binder can work out a correct order of
-- -- elaboration.
-- --
-- -- However, ancient versions of GNAT used to not generate code or ALI
-- -- files for generic units, and this would yield complex order of
-- -- elaboration issues. These were fixed in GNAT 3.10. The support for not
-- -- compiling language-defined library generics was retained nonetheless
-- -- to facilitate bootstrap. Specifically, it is convenient to have
-- -- the same list of files to be compiled for all stages. So, if the
-- -- bootstrap compiler does not generate code for a given file, then
-- -- the stage1 compiler (and binder) also must deal with the case of
-- -- that file not being compiled. The predicate Generic_May_Lack_ALI is
-- -- True for those generic units for which missing ALI files are allowed.
--
- procedure Write_Unit_Info
- (Unit_Num : Unit_Number_Type;
- Item : Node_Id;
-@@ -726,6 +750,7 @@ private
- pragma Inline (Main_CPU);
- pragma Inline (Main_Priority);
- pragma Inline (Munit_Index);
-+ pragma Inline (No_Elab_Code_All);
- pragma Inline (OA_Setting);
- pragma Inline (Set_Cunit);
- pragma Inline (Set_Cunit_Entity);
-@@ -735,12 +760,15 @@ private
- pragma Inline (Set_Loading);
- pragma Inline (Set_Main_CPU);
- pragma Inline (Set_Main_Priority);
-+ pragma Inline (Set_No_Elab_Code_All);
- pragma Inline (Set_OA_Setting);
- pragma Inline (Set_Unit_Name);
- pragma Inline (Source_Index);
- pragma Inline (Unit_File_Name);
- pragma Inline (Unit_Name);
-
-+ -- The Units Table
-+
- type Unit_Record is record
- Unit_File_Name : File_Name_Type;
- Unit_Name : Unit_Name_Type;
-@@ -756,10 +784,11 @@ private
- Serial_Number : Nat;
- Version : Word;
- Error_Location : Source_Ptr;
-- Fatal_Error : Boolean;
-+ Fatal_Error : Fatal_Type;
- Generate_Code : Boolean;
- Has_RACW : Boolean;
- Dynamic_Elab : Boolean;
-+ No_Elab_Code_All : Boolean;
- Filler : Boolean;
- Loading : Boolean;
- OA_Setting : Character;
-@@ -789,7 +818,8 @@ private
- Generate_Code at 57 range 0 .. 7;
- Has_RACW at 58 range 0 .. 7;
- Dynamic_Elab at 59 range 0 .. 7;
-- Filler at 60 range 0 .. 15;
-+ No_Elab_Code_All at 60 range 0 .. 7;
-+ Filler at 61 range 0 .. 7;
- OA_Setting at 62 range 0 .. 7;
- Loading at 63 range 0 .. 7;
- SPARK_Mode_Pragma at 64 range 0 .. 31;
-@@ -826,13 +856,8 @@ private
-
- -- The following table stores references to pragmas that generate Notes
-
-- type Notes_Entry is record
-- Pragma_Node : Node_Id;
-- Unit : Unit_Number_Type;
-- end record;
--
- package Notes is new Table.Table (
-- Table_Component_Type => Notes_Entry,
-+ Table_Component_Type => Node_Id,
- Table_Index_Type => Integer,
- Table_Low_Bound => 1,
- Table_Initial => Alloc.Notes_Initial,
-diff --git a/gnat/link.c b/gnat/link.c
-index 7b9d351..ee59147 100644
---- a/gnat/link.c
-+++ b/gnat/link.c
-@@ -6,7 +6,7 @@
- * *
- * C Implementation File *
- * *
-- * Copyright (C) 1992-2012, Free Software Foundation, Inc. *
-+ * Copyright (C) 1992-2014, 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- *
-@@ -15,9 +15,9 @@
- * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
- * or FITNESS FOR A PARTICULAR PURPOSE. *
- * *
-- * *
-- * *
-- * *
-+ * As a special exception under Section 7 of GPL version 3, you are granted *
-+ * additional permissions described in the GCC Runtime Library Exception, *
-+ * version 3.1, as published by the Free Software Foundation. *
- * *
- * You should have received a copy of the GNU General Public License and *
- * a copy of the GCC Runtime Library Exception along with this program; *
-@@ -153,7 +153,7 @@ const char *__gnat_run_path_option = "";
- char __gnat_shared_libgnat_default = STATIC;
- char __gnat_shared_libgcc_default = STATIC;
- int __gnat_link_max = 15000;
--const unsigned char __gnat_objlist_file_supported = 1;
-+unsigned char __gnat_objlist_file_supported = 1;
- const char *__gnat_object_library_extension = ".a";
- unsigned char __gnat_separate_run_path_options = 0;
- const char *__gnat_default_libgcc_subdir = "lib";
-diff --git a/gnat/makeutl.adb b/gnat/makeutl.adb
-index 73349dc..5960d3e 100644
---- a/gnat/makeutl.adb
-+++ b/gnat/makeutl.adb
-@@ -29,7 +29,6 @@ with Debug;
- with Err_Vars; use Err_Vars;
- with Errutil;
- with Fname;
--with Hostparm;
- with Osint; use Osint;
- with Output; use Output;
- with Opt; use Opt;
-@@ -624,13 +623,11 @@ package body Makeutl is
- end if;
-
- elsif Sw'Length >= 4
-- and then (Sw (2 .. 3) = "aL"
-- or else
-- Sw (2 .. 3) = "aO"
-- or else
-- Sw (2 .. 3) = "aI"
-- or else
-- (For_Gnatbind and then Sw (2 .. 3) = "A="))
-+ and then
-+ (Sw (2 .. 3) = "aL" or else
-+ Sw (2 .. 3) = "aO" or else
-+ Sw (2 .. 3) = "aI"
-+ or else (For_Gnatbind and then Sw (2 .. 3) = "A="))
- then
- Start := 4;
-
-@@ -710,7 +707,7 @@ package body Makeutl is
- ---------------------
-
- function Get_Install_Dir (S : String) return String is
-- Exec : String := Normalize_Pathname (S, Resolve_Links => True);
-+ Exec : String := S;
- Path_Last : Integer := 0;
-
- begin
-@@ -742,12 +739,6 @@ package body Makeutl is
- -- Beginning of Executable_Prefix_Path
-
- begin
-- -- For VMS, the path returned is always /gnu/
--
-- if Hostparm.OpenVMS then
-- return "/gnu/";
-- end if;
--
- -- First determine if a path prefix was placed in front of the
- -- executable name.
-
-@@ -786,7 +777,7 @@ package body Makeutl is
- Flush_Messages : Boolean := True)
- is
- begin
-- if Flush_Messages then
-+ if Flush_Messages and not No_Exit_Message then
- if Total_Errors_Detected /= 0 or else Warnings_Detected /= 0 then
- Errutil.Finalize;
- end if;
-@@ -815,8 +806,13 @@ package body Makeutl is
-
- if S'Length > 0 then
- if Exit_Code /= E_Success then
-- Osint.Fail (S);
-- else
-+ if No_Exit_Message then
-+ Osint.Exit_Program (E_Fatal);
-+ else
-+ Osint.Fail (S);
-+ end if;
-+
-+ elsif not No_Exit_Message then
- Write_Str (S);
- end if;
- end if;
-@@ -1434,8 +1430,6 @@ package body Makeutl is
- In_Tree : Project_Tree_Ref;
- Dummy : in out Boolean)
- is
-- pragma Unreferenced (Dummy);
--
- Linker_Package : Package_Id;
- Options : Variable_Value;
-
-@@ -2563,8 +2557,11 @@ package body Makeutl is
- for J in 1 .. Q.Last loop
- if Source.Id.Path.Name = Q.Table (J).Info.Id.Path.Name
- and then Source.Id.Index = Q.Table (J).Info.Id.Index
-- and then Source.Id.Project.Path.Name =
-- Q.Table (J).Info.Id.Project.Path.Name
-+ and then
-+ Ultimate_Extending_Project_Of (Source.Id.Project).Path.Name
-+ =
-+ Ultimate_Extending_Project_Of (Q.Table (J).Info.Id.Project).
-+ Path.Name
- then
- -- No need to insert this source in the queue, but still
- -- return True as we may need to insert its roots.
-@@ -2621,7 +2618,6 @@ package body Makeutl is
- Iter : Source_Iterator;
-
- Dummy : Boolean;
-- pragma Unreferenced (Dummy);
-
- begin
- if not Insert_No_Roots (Source) then
-@@ -2757,9 +2753,10 @@ package body Makeutl is
- Debug_Output
- (" -> ", Name_Id (Root_Source.Display_File));
- Dummy := Queue.Insert_No_Roots
-- (Source => (Format => Format_Gprbuild,
-- Tree => Source.Tree,
-- Id => Root_Source));
-+ (Source => (Format => Format_Gprbuild,
-+ Tree => Source.Tree,
-+ Id => Root_Source,
-+ Closure => False));
-
- Initialize_Source_Record (Root_Source);
-
-@@ -2811,7 +2808,6 @@ package body Makeutl is
- With_Roots : Boolean := False)
- is
- Discard : Boolean;
-- pragma Unreferenced (Discard);
- begin
- Discard := Insert (Source, With_Roots);
- end Insert;
-@@ -2915,31 +2911,39 @@ package body Makeutl is
- All_Projects : Boolean;
- Unique_Compile : Boolean)
- is
-- procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref);
-+
-+ procedure Do_Insert
-+ (Project : Project_Id;
-+ Tree : Project_Tree_Ref;
-+ Context : Project_Context);
-+ -- Local procedures must be commented ???
-
- ---------------
- -- Do_Insert --
- ---------------
-
-- procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is
-+ procedure Do_Insert
-+ (Project : Project_Id;
-+ Tree : Project_Tree_Ref;
-+ Context : Project_Context)
-+ is
- Unit_Based : constant Boolean :=
- Unique_Compile
- or else not Builder_Data (Tree).Closure_Needed;
-- -- When Unit_Based is True, put in the queue all compilable
-- -- sources including the unit based (Ada) one. When Unit_Based is
-- -- False, put the Ada sources only when they are in a library
-- -- project.
-+ -- When Unit_Based is True, we enqueue all compilable sources
-+ -- including the unit based (Ada) one. When Unit_Based is False,
-+ -- put the Ada sources only when they are in a library project.
-
-- Iter : Source_Iterator;
-- Source : Prj.Source_Id;
-+ Iter : Source_Iterator;
-+ Source : Prj.Source_Id;
-+ OK : Boolean;
-+ Closure : Boolean;
-
- begin
- -- Nothing to do when "-u" was specified and some files were
- -- specified on the command line
-
-- if Unique_Compile
-- and then Mains.Number_Of_Mains (Tree) > 0
-- then
-+ if Unique_Compile and then Mains.Number_Of_Mains (Tree) > 0 then
- return;
- end if;
-
-@@ -2950,16 +2954,13 @@ package body Makeutl is
-
- if Is_Allowed_Language (Source.Language.Name)
- and then Is_Compilable (Source)
-- and then
-- (All_Projects
-- or else Is_Extending (Project, Source.Project))
-+ and then (All_Projects
-+ or else Is_Extending (Project, Source.Project))
- and then not Source.Locally_Removed
- and then Source.Replaced_By = No_Source
-- and then
-- (not Source.Project.Externally_Built
-- or else
-- (Is_Extending (Project, Source.Project)
-- and then not Project.Externally_Built))
-+ and then (not Source.Project.Externally_Built
-+ or else (Is_Extending (Project, Source.Project)
-+ and then not Project.Externally_Built))
- and then Source.Kind /= Sep
- and then Source.Path /= No_Path_Information
- then
-@@ -2972,13 +2973,55 @@ package body Makeutl is
- then
- if (Unit_Based
- or else Source.Unit = No_Unit_Index
-- or else Source.Project.Library)
-+ or else Source.Project.Library
-+ or else Context.In_Aggregate_Lib
-+ or else Project.Qualifier = Aggregate_Library)
- and then not Is_Subunit (Source)
- then
-- Queue.Insert
-- (Source => (Format => Format_Gprbuild,
-- Tree => Tree,
-- Id => Source));
-+ OK := True;
-+ Closure := False;
-+
-+ if Source.Unit /= No_Unit_Index
-+ and then
-+ (Source.Project.Library
-+ or else Project.Qualifier = Aggregate_Library
-+ or else Context.In_Aggregate_Lib)
-+ and then Source.Project.Standalone_Library /= No
-+ then
-+ -- Check if the unit is in the interface
-+
-+ OK := False;
-+
-+ declare
-+ List : String_List_Id;
-+ Element : String_Element;
-+
-+ begin
-+ List := Source.Project.Lib_Interface_ALIs;
-+ while List /= Nil_String loop
-+ Element :=
-+ Project_Tree.Shared.String_Elements.Table
-+ (List);
-+
-+ if Element.Value = Name_Id (Source.Dep_Name)
-+ then
-+ OK := True;
-+ Closure := True;
-+ exit;
-+ end if;
-+
-+ List := Element.Next;
-+ end loop;
-+ end;
-+ end if;
-+
-+ if OK then
-+ Queue.Insert
-+ (Source => (Format => Format_Gprbuild,
-+ Tree => Tree,
-+ Id => Source,
-+ Closure => Closure));
-+ end if;
- end if;
- end if;
- end if;
-@@ -2987,7 +3030,8 @@ package body Makeutl is
- end loop;
- end Do_Insert;
-
-- procedure Insert_All is new For_Project_And_Aggregated (Do_Insert);
-+ procedure Insert_All is
-+ new For_Project_And_Aggregated_Context (Do_Insert);
-
- begin
- Insert_All (Project, Project_Tree);
-@@ -3068,9 +3112,10 @@ package body Makeutl is
- or else Src_Id.Project.Library_Kind = Static)
- then
- Queue.Insert
-- (Source => (Format => Format_Gprbuild,
-- Tree => Project_Tree,
-- Id => Src_Id));
-+ (Source => (Format => Format_Gprbuild,
-+ Tree => Project_Tree,
-+ Id => Src_Id,
-+ Closure => True));
- end if;
- end if;
- end loop;
-@@ -3155,7 +3200,10 @@ package body Makeutl is
- Data.Need_Linking := False;
-
- else
-- Data.Closure_Needed := Has_Mains;
-+ Data.Closure_Needed :=
-+ Has_Mains
-+ or else (Root_Project.Library
-+ and then Root_Project.Standalone_Library /= No);
- Data.Need_Compilation := All_Phases or Option_Compile_Only;
- Data.Need_Binding := All_Phases or Option_Bind_Only;
- Data.Need_Linking := (All_Phases or Option_Link_Only)
-diff --git a/gnat/makeutl.ads b/gnat/makeutl.ads
-index 370f32a..cf28b1e 100644
---- a/gnat/makeutl.ads
-+++ b/gnat/makeutl.ads
-@@ -79,6 +79,16 @@ package Makeutl is
- Create_Map_File_Switch : constant String := "--create-map-file";
- -- Switch to create a map file when an executable is linked
-
-+ No_Exit_Message_Option : constant String := "--no-exit-message";
-+ -- Switch to suppress exit error message when there are compilation
-+ -- failures. This is useful when a tool, such as gnatprove, silently calls
-+ -- the builder and does not want to pollute its output with error messages
-+ -- coming from the builder. This is an internal switch.
-+
-+ Keep_Temp_Files_Option : constant String := "--keep-temp-files";
-+ -- Switch to suppress deletion of temp files created by the builder.
-+ -- Note that debug switch -gnatdn also has this effect.
-+
- Load_Standard_Base : Boolean := True;
- -- False when gprbuild is called with --db-
-
-@@ -244,8 +254,8 @@ package Makeutl is
- -- file. This checks various attributes to see if there are file specific
- -- switches, or else defaults on the switches for the corresponding
- -- language. Is_Default is set to False if there were file-specific
-- -- switches Source_File can be set to No_File to force retrieval of the
-- -- default switches. If Test_Without_Suffix is True, and there is no " for
-+ -- switches. Source_File can be set to No_File to force retrieval of the
-+ -- default switches. If Test_Without_Suffix is True, and there is no "for
- -- Switches(Source_File) use", then this procedure also tests without the
- -- extension of the filename. If Test_Without_Suffix is True and
- -- Check_ALI_Suffix is True, then we also replace the file extension with
-@@ -489,8 +499,9 @@ package Makeutl is
- record
- case Format is
- when Format_Gprbuild =>
-- Tree : Project_Tree_Ref := No_Project_Tree;
-- Id : Source_Id := No_Source;
-+ Tree : Project_Tree_Ref := No_Project_Tree;
-+ Id : Source_Id := No_Source;
-+ Closure : Boolean := False;
-
- when Format_Gnatmake =>
- File : File_Name_Type := No_File;
-@@ -504,7 +515,8 @@ package Makeutl is
- -- depends on the builder, and in particular whether it only supports
- -- project-based files (in which case we have a full Source_Id record).
-
-- No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
-+ No_Source_Info : constant Source_Info :=
-+ (Format_Gprbuild, null, null, False);
-
- procedure Initialize
- (Queue_Per_Obj_Dir : Boolean;
-diff --git a/gnat/mlib-tgt.ads b/gnat/mlib-tgt.ads
-index cbb15d3..0260159 100644
---- a/gnat/mlib-tgt.ads
-+++ b/gnat/mlib-tgt.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 2001-2009, AdaCore --
-+-- Copyright (C) 2001-2014, AdaCore --
- -- --
- -- 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- --
-@@ -132,8 +132,8 @@ package MLib.Tgt is
- -- "libtoto.so" will be a symbolic link to "libtoto.so.2.1" which
- -- will be the actual library file.
- --
-- -- Symbol_Data is used for some platforms, including VMS, to generate
-- -- the symbols to be exported by the library.
-+ -- Symbol_Data is used for some platforms, to generate the symbols to be
-+ -- exported by the library (not certain if it is currently in use or not).
- --
- -- Note: Depending on the OS, some of the parameters may not be taken into
- -- account. For example, on Linux, Interfaces, Symbol_Data and Auto_Init
-diff --git a/gnat/mlib-utl.adb b/gnat/mlib-utl.adb
-index 756add1..91890a1 100644
---- a/gnat/mlib-utl.adb
-+++ b/gnat/mlib-utl.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2002-2013, AdaCore --
-+-- Copyright (C) 2002-2014, AdaCore --
- -- --
- -- 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- --
-@@ -282,6 +282,12 @@ package body MLib.Utl is
- if not Opt.Quiet_Output then
- Write_Str (Ranlib_Name.all);
- Write_Char (' ');
-+
-+ for J in Ranlib_Options'Range loop
-+ Write_Str (Ranlib_Options (J).all);
-+ Write_Char (' ');
-+ end loop;
-+
- Write_Line (Arguments (Ar_Options'Length + 1).all);
- end if;
-
-diff --git a/gnat/mlib.adb b/gnat/mlib.adb
-index 4c4d375..c4faea0 100644
---- a/gnat/mlib.adb
-+++ b/gnat/mlib.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1999-2009, AdaCore --
-+-- Copyright (C) 1999-2014, AdaCore --
- -- --
- -- 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- --
-@@ -27,7 +27,6 @@ with Ada.Characters.Handling; use Ada.Characters.Handling;
- with Interfaces.C.Strings;
- with System;
-
--with Hostparm;
- with Opt;
- with Output; use Output;
-
-@@ -206,8 +205,11 @@ package body MLib is
-
- S := new String (1 .. Len + 3);
-
-- -- Read the file. Note that the loop is not necessary
-- -- since the whole file is read at once except on VMS.
-+ -- Read the file. This loop is probably not necessary
-+ -- since on most (all?) targets, the whole file is
-+ -- read in at once, but we have encountered systems
-+ -- in the past where this was not true, and we retain
-+ -- this loop in case we encounter that in the future.
-
- Curr := S'First;
- while Curr <= Len loop
-@@ -459,12 +461,4 @@ package body MLib is
- return Separate_Paths;
- end Separate_Run_Path_Options;
-
---- Package elaboration
--
--begin
-- -- Copy_Attributes always fails on VMS
--
-- if Hostparm.OpenVMS then
-- Preserve := None;
-- end if;
- end MLib;
-diff --git a/gnat/mlib.ads b/gnat/mlib.ads
-index 0aa62d2..e370fa4 100644
---- a/gnat/mlib.ads
-+++ b/gnat/mlib.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1999-2009, AdaCore --
-+-- Copyright (C) 1999-2014, AdaCore --
- -- --
- -- 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- --
-@@ -89,9 +89,7 @@ package MLib is
- -- for each directory in the rpath.
-
- private
--
- Preserve : Attribute := Time_Stamps;
-- -- Used by Copy_ALI_Files. Changed to None for OpenVMS, because
-- -- Copy_Attributes always fails on VMS.
-+ -- Used by Copy_ALI_Files
-
- end MLib;
-diff --git a/gnat/namet.adb b/gnat/namet.adb
-index cd2b781..0eab3a1 100644
---- a/gnat/namet.adb
-+++ b/gnat/namet.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -705,6 +705,36 @@ package body Namet is
- end loop;
- end Get_Name_String_And_Append;
-
-+ -----------------------------
-+ -- Get_Name_Table_Boolean1 --
-+ -----------------------------
-+
-+ function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean is
-+ begin
-+ pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-+ return Name_Entries.Table (Id).Boolean1_Info;
-+ end Get_Name_Table_Boolean1;
-+
-+ -----------------------------
-+ -- Get_Name_Table_Boolean2 --
-+ -----------------------------
-+
-+ function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean is
-+ begin
-+ pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-+ return Name_Entries.Table (Id).Boolean2_Info;
-+ end Get_Name_Table_Boolean2;
-+
-+ -----------------------------
-+ -- Get_Name_Table_Boolean3 --
-+ -----------------------------
-+
-+ function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean is
-+ begin
-+ pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-+ return Name_Entries.Table (Id).Boolean3_Info;
-+ end Get_Name_Table_Boolean3;
-+
- -------------------------
- -- Get_Name_Table_Byte --
- -------------------------
-@@ -716,14 +746,14 @@ package body Namet is
- end Get_Name_Table_Byte;
-
- -------------------------
-- -- Get_Name_Table_Info --
-+ -- Get_Name_Table_Int --
- -------------------------
-
-- function Get_Name_Table_Info (Id : Name_Id) return Int is
-+ function Get_Name_Table_Int (Id : Name_Id) return Int is
- begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
- return Name_Entries.Table (Id).Int_Info;
-- end Get_Name_Table_Info;
-+ end Get_Name_Table_Int;
-
- -----------------------------------------
- -- Get_Unqualified_Decoded_Name_String --
-@@ -923,6 +953,9 @@ package body Namet is
- Name_Len => Short (Name_Len),
- Byte_Info => 0,
- Int_Info => 0,
-+ Boolean1_Info => False,
-+ Boolean2_Info => False,
-+ Boolean3_Info => False,
- Name_Has_No_Encodings => False,
- Hash_Link => No_Name));
-
-@@ -1025,7 +1058,10 @@ package body Namet is
- Hash_Link => No_Name,
- Name_Has_No_Encodings => False,
- Int_Info => 0,
-- Byte_Info => 0));
-+ Byte_Info => 0,
-+ Boolean1_Info => False,
-+ Boolean2_Info => False,
-+ Boolean3_Info => False));
-
- -- Set corresponding string entry in the Name_Chars table
-
-@@ -1133,6 +1169,106 @@ package body Namet is
- T = V7;
- end Nam_In;
-
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id) return Boolean
-+ is
-+ begin
-+ return T = V1 or else
-+ T = V2 or else
-+ T = V3 or else
-+ T = V4 or else
-+ T = V5 or else
-+ T = V6 or else
-+ T = V7 or else
-+ T = V8;
-+ end Nam_In;
-+
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id;
-+ V9 : Name_Id) return Boolean
-+ is
-+ begin
-+ return T = V1 or else
-+ T = V2 or else
-+ T = V3 or else
-+ T = V4 or else
-+ T = V5 or else
-+ T = V6 or else
-+ T = V7 or else
-+ T = V8 or else
-+ T = V9;
-+ end Nam_In;
-+
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id;
-+ V9 : Name_Id;
-+ V10 : Name_Id) return Boolean
-+ is
-+ begin
-+ return T = V1 or else
-+ T = V2 or else
-+ T = V3 or else
-+ T = V4 or else
-+ T = V5 or else
-+ T = V6 or else
-+ T = V7 or else
-+ T = V8 or else
-+ T = V9 or else
-+ T = V10;
-+ end Nam_In;
-+
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id;
-+ V9 : Name_Id;
-+ V10 : Name_Id;
-+ V11 : Name_Id) return Boolean
-+ is
-+ begin
-+ return T = V1 or else
-+ T = V2 or else
-+ T = V3 or else
-+ T = V4 or else
-+ T = V5 or else
-+ T = V6 or else
-+ T = V7 or else
-+ T = V8 or else
-+ T = V9 or else
-+ T = V10 or else
-+ T = V11;
-+ end Nam_In;
-+
- ------------------
- -- Reinitialize --
- ------------------
-@@ -1150,6 +1286,9 @@ package body Namet is
- Name_Len => 1,
- Byte_Info => 0,
- Int_Info => 0,
-+ Boolean1_Info => False,
-+ Boolean2_Info => False,
-+ Boolean3_Info => False,
- Name_Has_No_Encodings => True,
- Hash_Link => No_Name));
-
-@@ -1187,6 +1326,36 @@ package body Namet is
- Store_Encoded_Character (C);
- end Set_Character_Literal_Name;
-
-+ -----------------------------
-+ -- Set_Name_Table_Boolean1 --
-+ -----------------------------
-+
-+ procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean) is
-+ begin
-+ pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-+ Name_Entries.Table (Id).Boolean1_Info := Val;
-+ end Set_Name_Table_Boolean1;
-+
-+ -----------------------------
-+ -- Set_Name_Table_Boolean2 --
-+ -----------------------------
-+
-+ procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean) is
-+ begin
-+ pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-+ Name_Entries.Table (Id).Boolean2_Info := Val;
-+ end Set_Name_Table_Boolean2;
-+
-+ -----------------------------
-+ -- Set_Name_Table_Boolean3 --
-+ -----------------------------
-+
-+ procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean) is
-+ begin
-+ pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-+ Name_Entries.Table (Id).Boolean3_Info := Val;
-+ end Set_Name_Table_Boolean3;
-+
- -------------------------
- -- Set_Name_Table_Byte --
- -------------------------
-@@ -1198,14 +1367,14 @@ package body Namet is
- end Set_Name_Table_Byte;
-
- -------------------------
-- -- Set_Name_Table_Info --
-+ -- Set_Name_Table_Int --
- -------------------------
-
-- procedure Set_Name_Table_Info (Id : Name_Id; Val : Int) is
-+ procedure Set_Name_Table_Int (Id : Name_Id; Val : Int) is
- begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
- Name_Entries.Table (Id).Int_Info := Val;
-- end Set_Name_Table_Info;
-+ end Set_Name_Table_Int;
-
- -----------------------------
- -- Store_Encoded_Character --
-diff --git a/gnat/namet.ads b/gnat/namet.ads
-index 94cda18..6074575 100644
---- a/gnat/namet.ads
-+++ b/gnat/namet.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -115,14 +115,38 @@ package Namet is
- -- character lower case letters in the range a-z, and these names are created
- -- and initialized by the Initialize procedure.
-
---- Two values, one of type Int and one of type Byte, are stored with each
---- names table entry and subprograms are provided for setting and retrieving
---- these associated values. The usage of these values is up to the client. In
---- the compiler, the Int field is used to point to a chain of potentially
---- visible entities (see Sem.Ch8 for details), and the Byte field is used to
---- hold the Token_Type value for reserved words (see Sem for details). In the
---- binder, the Byte field is unused, and the Int field is used in various
---- ways depending on the name involved (see binder documentation).
-+-- Five values, one of type Int, one of type Byte, and three of type Boolean,
-+-- are stored with each names table entry and subprograms are provided for
-+-- setting and retrieving these associated values. The usage of these values
-+-- is up to the client:
-+
-+-- In the compiler we have the following uses:
-+
-+-- The Int field is used to point to a chain of potentially visible
-+-- entities (see Sem.Ch8 for details).
-+
-+-- The Byte field is used to hold the Token_Type value for reserved words
-+-- (see Sem for details).
-+
-+-- The Boolean1 field is used to mark address clauses to optimize the
-+-- performance of the Exp_Util.Following_Address_Clause function.
-+
-+-- The Boolean2 field is used to mark simple names that appear in
-+-- Restriction[_Warning]s pragmas for No_Use_Of_Entity. This avoids most
-+-- unnecessary searches of the No_Use_Of_Entity table.
-+
-+-- The Boolean3 field is not used
-+
-+-- In the binder, we have the following uses:
-+
-+-- The Int field is used in various ways depending on the name involved,
-+-- see binder documentation for details.
-+
-+-- The Byte and Boolean fields are unused.
-+
-+-- Note that the value of the Int and Byte fields are initialized to zero,
-+-- and the Boolean field is initialized to False, when a new Name table entry
-+-- is created.
-
- Name_Buffer : String (1 .. 4 * Max_Line_Length);
- -- This buffer is used to set the name to be stored in the table for the
-@@ -227,6 +251,56 @@ package Namet is
- V6 : Name_Id;
- V7 : Name_Id) return Boolean;
-
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id) return Boolean;
-+
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id;
-+ V9 : Name_Id) return Boolean;
-+
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id;
-+ V9 : Name_Id;
-+ V10 : Name_Id) return Boolean;
-+
-+ function Nam_In
-+ (T : Name_Id;
-+ V1 : Name_Id;
-+ V2 : Name_Id;
-+ V3 : Name_Id;
-+ V4 : Name_Id;
-+ V5 : Name_Id;
-+ V6 : Name_Id;
-+ V7 : Name_Id;
-+ V8 : Name_Id;
-+ V9 : Name_Id;
-+ V10 : Name_Id;
-+ V11 : Name_Id) return Boolean;
-+
- pragma Inline (Nam_In);
- -- Inline all above functions
-
-@@ -295,10 +369,15 @@ package Namet is
- pragma Inline (Get_Name_Table_Byte);
- -- Fetches the Byte value associated with the given name
-
-- function Get_Name_Table_Info (Id : Name_Id) return Int;
-- pragma Inline (Get_Name_Table_Info);
-+ function Get_Name_Table_Int (Id : Name_Id) return Int;
-+ pragma Inline (Get_Name_Table_Int);
- -- Fetches the Int value associated with the given name
-
-+ function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean;
-+ function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean;
-+ function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean;
-+ -- Fetches the Boolean values associated with the given name
-+
- function Is_Operator_Name (Id : Name_Id) return Boolean;
- -- Returns True if name given is of the form of an operator (that
- -- is, it starts with an upper case O).
-@@ -336,12 +415,12 @@ package Namet is
- function Name_Find return Name_Id;
- -- Name_Find is called with a string stored in Name_Buffer whose length is
- -- in Name_Len (i.e. the characters of the name are in subscript positions
-- -- 1 to Name_Len in Name_Buffer). It searches the names table to see if
-- -- the string has already been stored. If so the Id of the existing entry
-- -- is returned. Otherwise a new entry is created with its Name_Table_Info
-- -- field set to zero. The contents of Name_Buffer and Name_Len are not
-- -- modified by this call. Note that it is permissible for Name_Len to be
-- -- set to zero to lookup the null name string.
-+ -- 1 to Name_Len in Name_Buffer). It searches the names table to see if the
-+ -- string has already been stored. If so the Id of the existing entry is
-+ -- returned. Otherwise a new entry is created with its Name_Table_Int
-+ -- fields set to zero/false. The contents of Name_Buffer and Name_Len are
-+ -- not modified by this call. Note that it is permissible for Name_Len to
-+ -- be set to zero to lookup the null name string.
-
- function Name_Enter return Name_Id;
- -- Name_Enter has the same calling interface as Name_Find. The difference
-@@ -425,14 +504,19 @@ package Namet is
- -- for the given character code. On return Name_Buffer and Name_Len are
- -- set to reflect the stored name.
-
-- procedure Set_Name_Table_Info (Id : Name_Id; Val : Int);
-- pragma Inline (Set_Name_Table_Info);
-+ procedure Set_Name_Table_Int (Id : Name_Id; Val : Int);
-+ pragma Inline (Set_Name_Table_Int);
- -- Sets the Int value associated with the given name
-
- procedure Set_Name_Table_Byte (Id : Name_Id; Val : Byte);
- pragma Inline (Set_Name_Table_Byte);
- -- Sets the Byte value associated with the given name
-
-+ procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean);
-+ procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean);
-+ procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean);
-+ -- Sets the Boolean value associated with the given name
-+
- procedure Store_Encoded_Character (C : Char_Code);
- -- Stores given character code at the end of Name_Buffer, updating the
- -- value in Name_Len appropriately. Lower case letters and digits are
-@@ -570,6 +654,11 @@ private
- Byte_Info : Byte;
- -- Byte value associated with this name
-
-+ Boolean1_Info : Boolean;
-+ Boolean2_Info : Boolean;
-+ Boolean3_Info : Boolean;
-+ -- Boolean values associated with the name
-+
- Name_Has_No_Encodings : Boolean;
- -- This flag is set True if the name entry is known not to contain any
- -- special character encodings. This is used to speed up repeated calls
-@@ -581,13 +670,17 @@ private
-
- Int_Info : Int;
- -- Int Value associated with this name
-+
- end record;
-
- for Name_Entry use record
- Name_Chars_Index at 0 range 0 .. 31;
- Name_Len at 4 range 0 .. 15;
- Byte_Info at 6 range 0 .. 7;
-- Name_Has_No_Encodings at 7 range 0 .. 7;
-+ Boolean1_Info at 7 range 0 .. 0;
-+ Boolean2_Info at 7 range 1 .. 1;
-+ Boolean3_Info at 7 range 2 .. 2;
-+ Name_Has_No_Encodings at 7 range 3 .. 7;
- Hash_Link at 8 range 0 .. 31;
- Int_Info at 12 range 0 .. 31;
- end record;
-diff --git a/gnat/nlists.adb b/gnat/nlists.adb
-index c28eafe..dcb5dd4 100644
---- a/gnat/nlists.adb
-+++ b/gnat/nlists.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -744,8 +744,8 @@ package body Nlists is
-
- else
- NL := New_List;
-- E := First (List);
-
-+ E := First (List);
- while Present (E) loop
- if Comes_From_Source (E) then
- Append (New_Copy (E), NL);
-diff --git a/gnat/nlists.ads b/gnat/nlists.ads
-index d29151a..5950b4a 100644
---- a/gnat/nlists.ads
-+++ b/gnat/nlists.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -149,7 +149,6 @@ package Nlists is
- -- No_List. (No_List is not considered to be the same as an empty list).
-
- function List_Length (List : List_Id) return Nat;
-- pragma Inline (List_Length);
- -- Returns number of items in the given list. It is an error to call
- -- this function with No_List (No_List is not considered to be the same
- -- as an empty list).
-@@ -226,9 +225,9 @@ package Nlists is
-
- procedure Append (Node : Node_Or_Entity_Id; To : List_Id);
- -- Appends Node at the end of node list To. Node must be a non-empty node
-- -- that is not already a member of a node list, and To must be a
-- -- node list. An attempt to append an error node is ignored without
-- -- complaint and the list is unchanged.
-+ -- that is not already a member of a node list, and To must be a node list.
-+ -- An attempt to append an error node is ignored without complaint and the
-+ -- list is unchanged.
-
- procedure Append_To (To : List_Id; Node : Node_Or_Entity_Id);
- pragma Inline (Append_To);
-diff --git a/gnat/opt.adb b/gnat/opt.adb
-index e9fa74b..0afab65 100644
---- a/gnat/opt.adb
-+++ b/gnat/opt.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -63,7 +63,7 @@ package body Opt is
- Optimize_Alignment_Config := Optimize_Alignment;
- Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
- Polling_Required_Config := Polling_Required;
-- Short_Descriptors_Config := Short_Descriptors;
-+ Prefix_Exception_Messages_Config := Prefix_Exception_Messages;
- SPARK_Mode_Config := SPARK_Mode;
- SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma;
- Uneval_Old_Config := Uneval_Old;
-@@ -103,7 +103,7 @@ package body Opt is
- Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
- Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
- Polling_Required := Save.Polling_Required;
-- Short_Descriptors := Save.Short_Descriptors;
-+ Prefix_Exception_Messages := Save.Prefix_Exception_Messages;
- SPARK_Mode := Save.SPARK_Mode;
- SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
- Uneval_Old := Save.Uneval_Old;
-@@ -144,7 +144,7 @@ package body Opt is
- Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
- Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
- Save.Polling_Required := Polling_Required;
-- Save.Short_Descriptors := Short_Descriptors;
-+ Save.Prefix_Exception_Messages := Prefix_Exception_Messages;
- Save.SPARK_Mode := SPARK_Mode;
- Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma;
- Save.Uneval_Old := Uneval_Old;
-@@ -171,12 +171,14 @@ package body Opt is
-
- Ada_Version := Ada_Version_Runtime;
- Ada_Version_Pragma := Empty;
-+ Default_SSO := ' ';
- Dynamic_Elaboration_Checks := False;
- Extensions_Allowed := True;
- External_Name_Exp_Casing := As_Is;
- External_Name_Imp_Casing := Lowercase;
- Optimize_Alignment := 'O';
- Persistent_BSS_Mode := False;
-+ Prefix_Exception_Messages := True;
- Uneval_Old := 'E';
- Use_VADS_Size := False;
- Optimize_Alignment_Local := True;
-@@ -193,7 +195,6 @@ package body Opt is
- Assertions_Enabled := Assertions_Enabled_Config;
- Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
- Check_Policy_List := Check_Policy_List_Config;
-- Default_SSO := Default_SSO_Config;
- SPARK_Mode := SPARK_Mode_Config;
- SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config;
- else
-@@ -224,6 +225,7 @@ package body Opt is
- Optimize_Alignment := Optimize_Alignment_Config;
- Optimize_Alignment_Local := False;
- Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
-+ Prefix_Exception_Messages := Prefix_Exception_Messages_Config;
- SPARK_Mode := SPARK_Mode_Config;
- SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config;
- Uneval_Old := Uneval_Old_Config;
-@@ -239,12 +241,13 @@ package body Opt is
- Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
- end if;
-
-+ -- Values set for all units
-+
- Default_Pool := Default_Pool_Config;
- Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
- Fast_Math := Fast_Math_Config;
- Optimize_Alignment := Optimize_Alignment_Config;
- Polling_Required := Polling_Required_Config;
-- Short_Descriptors := Short_Descriptors_Config;
- end Set_Opt_Config_Switches;
-
- ---------------
-diff --git a/gnat/opt.ads b/gnat/opt.ads
-index 7d4f4bd..ceaefd9 100644
---- a/gnat/opt.ads
-+++ b/gnat/opt.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -224,7 +224,7 @@ package Opt is
- -- GNAT Normally, in accordance with (RM 13.9.1 (9-11)) the front end
- -- assumes that values could have invalid representations, unless it can
- -- clearly prove that the values are valid. If this switch is set (by
-- -- pragma Assume_No_Invalid_Values (Off)), then the compiler assumes values
-+ -- pragma Assume_No_Invalid_Values (On)), then the compiler assumes values
- -- are valid and in range of their representations. This feature is now
- -- fully enabled in the compiler.
-
-@@ -246,6 +246,13 @@ package Opt is
- -- default can be modified using -gnatd.L (sets the flag True). This is
- -- used to test the possibility of having the backend handle this.
-
-+ Back_End_Inlining : Boolean := False;
-+ -- GNAT
-+ -- Set True to activate inlining by back-end expansion. This is the normal
-+ -- default mode for gcc targets, so it is True on such targets unless the
-+ -- switches -gnatN or -gnatd.z are used. See circuitry in gnat1drv for the
-+ -- exact conditions for setting this switch.
-+
- Bind_Alternate_Main_Name : Boolean := False;
- -- GNATBIND
- -- True if main should be called Alternate_Main_Name.all.
-@@ -366,14 +373,17 @@ package Opt is
- -- True if source lines removed by the preprocessor should be commented
- -- in the output file.
-
-+ Compilation_Time : String (1 .. 19);
-+ -- GNAT
-+ -- Compilation date and time in form YYYY-MM-DD HH:MM:SS
-+
- Compile_Only : Boolean := False;
- -- GNATMAKE, GNATCLEAN, GPRMAKE, GPBUILD, GPRCLEAN
- -- GNATMAKE, GPRMAKE, GPRMAKE:
-- -- set to True to skip bind and link steps (except when Bind_Only is
-- -- True).
-+ -- set True to skip bind and link steps (except when Bind_Only is True)
- -- GNATCLEAN, GPRCLEAN:
-- -- set to True to delete only the files produced by the compiler but not
-- -- the library files or the executable files.
-+ -- set True to delete only the files produced by the compiler but not the
-+ -- library files or the executable files.
-
- Compiler_Unit : Boolean := False;
- -- GNAT1
-@@ -411,12 +421,9 @@ package Opt is
-
- subtype Debug_Level_Value is Nat range 0 .. 3;
- Debugger_Level : Debug_Level_Value := 0;
-- -- GNATBIND
- -- The value given to the -g parameter. The default value for -g with
-- -- no value is 2. This is usually ignored by GNATBIND, except in the
-- -- VMS version where it is passed as an argument to __gnat_initialize
-- -- to trigger the activation of the remote debugging interface.
-- -- Is this still true ???
-+ -- no value is 2. This is not currently used but is retained for possible
-+ -- future use.
-
- Default_Exit_Status : Int := 0;
- -- GNATBIND
-@@ -632,19 +639,6 @@ package Opt is
- -- Indicates the current setting of Fast_Math mode, as set by the use
- -- of a Fast_Math pragma (set True by Fast_Math (On)).
-
-- Float_Format : Character := ' ';
-- -- GNAT
-- -- A non-blank value indicates that a Float_Format pragma has been
-- -- processed, in which case this variable is set to 'I' for IEEE or to
-- -- 'V' for VAX. The setting of 'V' is only possible on OpenVMS versions
-- -- of GNAT.
--
-- Float_Format_Long : Character := ' ';
-- -- GNAT
-- -- A non-blank value indicates that a Long_Float pragma has been processed
-- -- (this pragma is recognized only in OpenVMS versions of GNAT), in which
-- -- case this variable is set to D or G for D_Float or G_Float.
--
- Force_ALI_Tree_File : Boolean := False;
- -- GNAT
- -- Force generation of ALI file even if errors are encountered. Also forces
-@@ -654,6 +648,20 @@ package Opt is
- -- GNAT
- -- Disable generation of ALI file
-
-+ Follow_Links_For_Files : Boolean := False;
-+ -- PROJECT MANAGER
-+ -- Set to True (-eL) to process the project files in trusted mode. If
-+ -- Follow_Links is False, it is assumed that the project doesn't contain
-+ -- any file duplicated through symbolic links (although the latter are
-+ -- still valid if they point to a file which is outside of the project),
-+ -- and that no directory has a name which is a valid source name.
-+
-+ Follow_Links_For_Dirs : Boolean := False;
-+ -- PROJECT MANAGER
-+ -- Set to True if directories can be links in this project, and therefore
-+ -- additional system calls must be performed to ensure that we always see
-+ -- the same full name for each directory.
-+
- Force_Checking_Of_Elaboration_Flags : Boolean := False;
- -- GNATBIND
- -- True if binding with forced checking of the elaboration flags
-@@ -663,12 +671,18 @@ package Opt is
- -- GNATMAKE, GPRMAKE, GPRBUILD
- -- Set to force recompilations even when the objects are up-to-date.
-
-+ Front_End_Inlining : Boolean := False;
-+ -- GNAT
-+ -- Set True to activate inlining by front-end expansion (even on GCC
-+ -- targets, where inlining is normally handled by the back end). Set by
-+ -- the flag -gnatN (which is now considered obsolescent, since the GCC
-+ -- back end can do a better job of inlining than the front end these days.
-+
- Full_Path_Name_For_Brief_Errors : Boolean := False;
- -- PROJECT MANAGER
-- -- When True, in Brief_Output mode, each error message line
-- -- will start with the full path name of the source.
-- -- When False, only the file name without directory information
-- -- is used.
-+ -- When True, in Brief_Output mode, each error message line will start with
-+ -- the full path name of the source. When False, only the file name without
-+ -- directory information is used.
-
- Full_List : Boolean := False;
- -- GNAT
-@@ -682,14 +696,18 @@ package Opt is
-
- Generate_CodePeer_Messages : Boolean := False;
- -- GNAT
-- -- Generate CodePeer messages. Ignored if CodePeer_Mode is false.
-- -- This is turned on by -gnateC.
-+ -- Generate CodePeer messages. Ignored if CodePeer_Mode is false. This is
-+ -- turned on by -gnateC.
-
- Generate_Processed_File : Boolean := False;
- -- GNAT
- -- True when switch -gnateG is used. When True, create in a file
- -- <source>.prep, if the source is preprocessed.
-
-+ Generate_SCIL : Boolean := False;
-+ -- GNAT
-+ -- Set True to activate SCIL code generation.
-+
- Generate_SCO : Boolean := False;
- -- GNAT
- -- True when switch -fdump-scos (or -gnateS) is used. When True, Source
-@@ -698,27 +716,37 @@ package Opt is
-
- Generate_SCO_Instance_Table : Boolean := False;
- -- GNAT
-- -- True when switch -fdebug-instances is used. When True, a table of
-- -- instances is included in SCOs.
-+ -- True when switch -fdump-scos is used. When True, a table of instances is
-+ -- included in SCOs.
-
- Generating_Code : Boolean := False;
- -- GNAT
- -- True if the frontend finished its work and has called the backend to
- -- process the tree and generate the object file.
-
-+ type Ghost_Mode_Type is (None, Check, Ignore);
-+ -- Possible legal modes that can be set by aspect/pragma Ghost as well as
-+ -- value None, which indicates that no such aspect/pragma applies.
-+
-+ Ghost_Mode : Ghost_Mode_Type := None;
-+ -- GNAT
-+ -- Current Ghost mode setting
-+
- Global_Discard_Names : Boolean := False;
- -- GNAT, GNATBIND
- -- True if a pragma Discard_Names appeared as a configuration pragma for
- -- the current compilation unit.
-
-- GNAT_Mode : Boolean := False;
-- -- GNAT
-- -- True if compiling in GNAT system mode (-gnatg switch)
-+ GNAT_Encodings : Int;
-+ pragma Import (C, GNAT_Encodings, "gnat_encodings");
-+ -- Constant controlling the balance between GNAT encodings and standard
-+ -- DWARF to emit in the debug information. See jmissing.c and aamissing.c
-+ -- for definitions for dotnet/jgnat and GNAAMP back ends. It accepts the
-+ -- following values.
-
-- Heap_Size : Nat := 0;
-- -- GNATBIND
-- -- Heap size for memory allocations. Valid values are 32 and 64. Only
-- -- available on VMS.
-+ DWARF_GNAT_Encodings_All : constant Int := 0;
-+ DWARF_GNAT_Encodings_GDB : constant Int := 1;
-+ DWARF_GNAT_Encodings_Minimal : constant Int := 2;
-
- Identifier_Character_Set : Character;
- -- GNAT
-@@ -743,6 +771,12 @@ package Opt is
- -- default value appropriate to the system (in Osint.Initialize), and then
- -- reset if a command line switch is used to change the setting.
-
-+ Ignore_Pragma_SPARK_Mode : Boolean := False;
-+ -- GNAT
-+ -- Set True to ignore the semantics and effects of pragma SPARK_Mode when
-+ -- the pragma appears inside an instance whose enclosing context is subject
-+ -- to SPARK_Mode "off".
-+
- Ignore_Rep_Clauses : Boolean := False;
- -- GNAT
- -- Set True to ignore all representation clauses. Useful when compiling
-@@ -773,9 +807,11 @@ package Opt is
-
- Ineffective_Inline_Warnings : Boolean := False;
- -- GNAT
-- -- Set True to activate warnings if front-end inlining (-gnatN) is not
-- -- able to actually inline a particular call (or all calls). Can be
-- -- controlled by use of -gnatwp/-gnatwP.
-+ -- Set True to activate warnings if front-end inlining (-gnatN) is not able
-+ -- to actually inline a particular call (or all calls). Can be controlled
-+ -- by use of -gnatwp/-gnatwP. Also set True to activate warnings if
-+ -- frontend inlining is not able to inline a subprogram expected to
-+ -- be inlined in GNATprove mode.
-
- Init_Or_Norm_Scalars : Boolean := False;
- -- GNAT, GANTBIND
-@@ -811,32 +847,10 @@ package Opt is
- -- then elaboration flag checks are to be generated in the binder
- -- generated file.
-
-- Generate_SCIL : Boolean := False;
-- -- GNAT
-- -- Set True to activate SCIL code generation.
--
- Invalid_Value_Used : Boolean := False;
- -- GNAT
- -- Set True if a valid Invalid_Value attribute is encountered
-
-- Follow_Links_For_Files : Boolean := False;
-- -- PROJECT MANAGER
-- -- Set to True (-eL) to process the project files in trusted mode. If
-- -- Follow_Links is False, it is assumed that the project doesn't contain
-- -- any file duplicated through symbolic links (although the latter are
-- -- still valid if they point to a file which is outside of the project),
-- -- and that no directory has a name which is a valid source name.
--
-- Follow_Links_For_Dirs : Boolean := False;
-- -- PROJECT MANAGER
-- -- Set to True if directories can be links in this project, and therefore
-- -- additional system calls must be performed to ensure that we always see
-- -- the same full name for each directory.
--
-- Front_End_Inlining : Boolean := False;
-- -- GNAT
-- -- Set True to activate inlining by front-end expansion
--
- Inline_Processing_Required : Boolean := False;
- -- GNAT
- -- Set True if inline processing is required. Inline processing is required
-@@ -855,9 +869,9 @@ package Opt is
- -- sources until there is no more work.
-
- Keep_Temporary_Files : Boolean := False;
-- -- GNATCMD
-- -- When True the temporary files created by the GNAT driver are not
-- -- deleted. Set by switch -dn or qualifier /KEEP_TEMPORARY_FILES.
-+ -- GNATCMD, GNATMAKE, GPRBUILD
-+ -- When True the temporary files are not deleted. Set by switches -dn or
-+ -- --keep-temp-files.
-
- Leap_Seconds_Support : Boolean := False;
- -- GNATBIND
-@@ -899,10 +913,9 @@ package Opt is
-
- List_Dependencies : Boolean := False;
- -- GNATMAKE
-- -- When True gnatmake verifies that the objects are up to date and
-- -- outputs the list of object dependencies (-M switch).
-- -- Output depends if -a switch is used or not.
-- -- This list can be used directly in a Makefile.
-+ -- When True gnatmake verifies that the objects are up to date and outputs
-+ -- the list of object dependencies (-M switch). Output depends if -a switch
-+ -- is used or not. This list can be used directly in a Makefile.
-
- List_Representation_Info : Int range 0 .. 3 := 0;
- -- GNAT
-@@ -1048,6 +1061,11 @@ package Opt is
- -- Undefined_Symbols_Are_False. Useful to perform a syntax check on all
- -- branches of #if constructs.
-
-+ No_Elab_Code_All_Pragma : Node_Id := Empty;
-+ -- Set to point to a No_Elaboration_Code_All pragma or aspect encountered
-+ -- in the spec of the extended main unit. Used to determine if we need to
-+ -- do special tests for violation of this aspect.
-+
- No_Main_Subprogram : Boolean := False;
- -- GNATMAKE, GNATBIND
- -- Set to True if compilation/binding of a program without main
-@@ -1055,8 +1073,8 @@ package Opt is
-
- No_Run_Time_Mode : Boolean := False;
- -- GNAT, GNATBIND
-- -- This flag is set True if a No_Run_Time pragma is encountered. See
-- -- spec of Rtsfind for a full description of handling of this pragma.
-+ -- This flag is set True if a No_Run_Time pragma is encountered. See spec
-+ -- of Rtsfind for a full description of handling of this pragma.
-
- No_Split_Units : Boolean := False;
- -- GPRBUILD
-@@ -1076,6 +1094,11 @@ package Opt is
- -- GNAT
- -- Set True if pragma No_Strict_Aliasing with no parameters encountered.
-
-+ No_Tagged_Streams : Node_Id := Empty;
-+ -- GNAT
-+ -- If a pragma No_Tagged_Streams is active for the current scope, this
-+ -- points to the corresponding pragma.
-+
- Normalize_Scalars : Boolean := False;
- -- GNAT, GNATBIND
- -- Set True if a pragma Normalize_Scalars applies to the current unit.
-@@ -1187,15 +1210,18 @@ package Opt is
- -- Set to True if polling for asynchronous abort is enabled by using
- -- the -gnatP option for GNAT.
-
-+ Prefix_Exception_Messages : Boolean := False;
-+ -- GNAT
-+ -- Set True to prefix exception messages with entity-name:
-+
- Preprocessing_Data_File : String_Ptr := null;
- -- GNAT
- -- Set by switch -gnatep=. The file name of the preprocessing data file.
-
- Preprocessing_Symbol_Defs : String_List_Access := new String_List (1 .. 4);
- -- An extensible array to temporarily stores symbol definitions specified
-- -- on the command line with -gnateD switches.
-- -- What is this magic constant 4 ???
-- -- What is extensible about this fixed length array ???
-+ -- on the command line with -gnateD switches. The value 4 is an arbitrary
-+ -- starting point, if more space is needed it is allocated as required.
-
- Preprocessing_Symbol_Last : Natural := 0;
- -- Index of last symbol definition in array Symbol_Definitions
-@@ -1240,13 +1266,13 @@ package Opt is
-
- Relaxed_RM_Semantics : Boolean := False;
- -- GNAT
-- -- Set to True to ignore some Ada semantic error to help parse legacy
-- -- Ada code for use in e.g. static analysis (such as CodePeer). This
-- -- deals with cases where other compilers allow illegal constructs. Tools
-- -- such as CodePeer are interested in analyzing code rather than enforcing
-- -- legality rules, so as long as these illegal constructs end up with code
-- -- that can be handled by the tool in question, there is no reason to
-- -- reject the code that is considered correct by the other compiler.
-+ -- Set to True to ignore some Ada semantic error to help parse legacy Ada
-+ -- code for use in e.g. static analysis (such as CodePeer). This deals
-+ -- with cases where other compilers allow illegal constructs. Tools such as
-+ -- CodePeer are interested in analyzing code rather than enforcing legality
-+ -- rules, so as long as these illegal constructs end up with code that can
-+ -- be handled by the tool in question, there is no reason to reject the
-+ -- code that is considered correct by the other compiler.
-
- Replace_In_Comments : Boolean := False;
- -- GNATPREP
-@@ -1295,10 +1321,6 @@ package Opt is
- -- GNAT
- -- Set True if a pragma Short_Circuit_And_Or applies to the current unit.
-
-- Short_Descriptors : Boolean := False;
-- -- GNAT
-- -- Set True if a pragma Short_Descriptors applies to the current unit.
--
- type SPARK_Mode_Type is (None, Off, On);
- -- Possible legal modes that can be set by aspect/pragma SPARK_Mode, as
- -- well as the value None, which indicates no such pragma/aspect applies.
-@@ -1417,6 +1439,16 @@ package Opt is
- -- Get_Targ and Set_Targ for full details) using the name given by
- -- this switch. Set to non-null file name by use of the -gnatet switch.
-
-+ type Origin_Of_Target is (Unknown, Default, Specified);
-+
-+ Target_Origin : Origin_Of_Target := Unknown;
-+ -- GPRBUILD
-+ -- Indicates the origin of attribute Target in project files
-+
-+ Target_Value : String_Access := null;
-+ -- GPRBUILD
-+ -- Indicates the value of attribute Target in project files
-+
- Task_Dispatching_Policy : Character := ' ';
- -- GNAT, GNATBIND
- -- Set to ' ' for the default case (no task dispatching policy specified).
-@@ -1467,12 +1499,6 @@ package Opt is
- -- GNAT
- -- Set to True (-gnatt) to generate output tree file
-
-- True_VMS_Target : Boolean := False;
-- -- Set True if we are on a VMS target. The setting of this flag reflects
-- -- the true state of the compile, unlike Targparm.OpenVMS_On_Target which
-- -- can also be true when debug flag m is set (-gnatdm). This is used in the
-- -- few cases where we do NOT want -gnatdm to trigger the VMS behavior.
--
- Try_Semantics : Boolean := False;
- -- GNAT
- -- Flag set to force attempt at semantic analysis, even if parser errors
-@@ -1643,6 +1669,13 @@ package Opt is
- -- Set to True to generate warnings for suspicious use of export or
- -- import pragmas. Modified by use of -gnatwx/X.
-
-+ Warn_On_Elab_Access : Boolean := False;
-+ -- GNAT
-+ -- Set to True to generate warnings for P'Access in the case where
-+ -- subprogram P is in the same package as the P'Access, and the P'Access is
-+ -- evaluated at package elaboration time, and occurs before the body of P
-+ -- has been elaborated.
-+
- Warn_On_Hiding : Boolean := False;
- -- GNAT
- -- Set to True to generate warnings if a declared entity hides another
-@@ -1726,7 +1759,9 @@ package Opt is
- Warn_On_Suspicious_Contract : Boolean := True;
- -- GNAT
- -- Set to True to generate warnings for suspicious contracts expressed as
-- -- pragmas or aspects precondition and postcondition. The default is that
-+ -- pragmas or aspects precondition and postcondition, as well as other
-+ -- suspicious cases of expressions typically found in contracts like
-+ -- quantified expressions and uses of Update attribute. The default is that
- -- this warning is enabled. Modified by use of -gnatw.t/.T.
-
- Warn_On_Suspicious_Modulus_Value : Boolean := True;
-@@ -1929,6 +1964,11 @@ package Opt is
- -- This switch is not set when the pragma appears ahead of a given
- -- unit, so it does not affect the compilation of other units.
-
-+ No_Exit_Message : Boolean := False;
-+ -- GNATMAKE, GPRBUILD
-+ -- Set with switch --no-exit-message. When True, if there are compilation
-+ -- failures, the builder does not issue an exit error message.
-+
- Optimize_Alignment_Config : Character;
- -- GNAT
- -- This is the value of the configuration switch that controls the
-@@ -1954,13 +1994,8 @@ package Opt is
- -- flag is used to set the initial value for Polling_Required at the start
- -- of analyzing each unit.
-
-- Short_Descriptors_Config : Boolean;
-- -- GNAT
-- -- This is the value of the configuration switch that controls the use of
-- -- Short_Descriptors for setting descriptor default sizes. It can be set
-- -- True by the use of the pragma Short_Descriptors in the gnat.adc file.
-- -- This flag is used to set the initial value for Short_Descriptors at the
-- -- start of analyzing each unit.
-+ Prefix_Exception_Messages_Config : Boolean;
-+ -- The setting of Prefix_Exception_Messages from configuration pragmas
-
- SPARK_Mode_Config : SPARK_Mode_Type := None;
- -- GNAT
-@@ -2107,6 +2142,73 @@ package Opt is
- -- appropriately licensed unit to declare this as a Table failed with
- -- various elaboration circularities. Memory is getting cheap these days!
-
-+ ---------------
-+ -- GNAT_Mode --
-+ ---------------
-+
-+ GNAT_Mode : Boolean := False;
-+ -- GNAT
-+ -- True if compiling in GNAT system mode (-gnatg switch)
-+
-+ -- Setting this switch has the following effects on the language that is
-+ -- accepted. Note that several of the following have the effect of changing
-+ -- an error to a warning. But warnings are usually treated as fatal errors
-+ -- in -gnatg mode, so to actually take advantage of such a change, it is
-+ -- necessary to add an explicit pragma Warnings (Off) in the source and
-+ -- this requires clear documentation of why this is necessary.
-+
-+ -- The identifier character set is set to 'n' (7-bit ASCII)
-+
-+ -- Pragma Extend_System is ignored
-+
-+ -- Warning_Mode is set to Treat_As_Error (-gnatwe)
-+
-+ -- Standard style checks are set (See Set_GNAT_Style_Check_Options)
-+
-+ -- Standard warnings are turned on (see Set_GNAT_Mode_Warnings)
-+
-+ -- The Ada version is set to Ada 2012
-+
-+ -- Task priorities are always allowed to be in the range Any_Priority
-+
-+ -- Overflow checks are suppressed, overflow checking set to strict mode
-+
-+ -- ALI files are always generated for predefined generic packages
-+
-+ -- Obsolescent feature warnings are suppressed
-+
-+ -- Recompilation of children of GNAT, System, Ada, Interfaces is allowed
-+
-+ -- The Scalar_Storage_Order attribute applies to generic types
-+
-+ -- Categorization errors are treated as warnings rather than errors
-+
-+ -- Statements in preelaborated units give warnings rather than errors
-+
-+ -- Private objects are allowed in preelaborated units
-+
-+ -- Non-static constants in preelaborated units give warnings not errors
-+
-+ -- The warning about component size being ignored is suppressed
-+
-+ -- The warning about size clauses being ignored is suppressed
-+
-+ -- Initializing limited types gives a warning rather than an error
-+
-+ -- Copying of limited objects is allowed
-+
-+ -- Returning objects of limited types is allowed
-+
-+ -- Non-static call in preelaborated unit give a warning, not an error
-+
-+ -- Warnings on possible elaboration errors are suppressed
-+
-+ -- Warnings about packing being ignored are suppressed
-+
-+ -- Warnings in internal units are not suppressed (they normally are)
-+
-+ -- The only special comment sequence allowed is --!
-+
- --------------------------
- -- Private Declarations --
- --------------------------
-@@ -2142,7 +2244,7 @@ private
- Optimize_Alignment_Local : Boolean;
- Persistent_BSS_Mode : Boolean;
- Polling_Required : Boolean;
-- Short_Descriptors : Boolean;
-+ Prefix_Exception_Messages : Boolean;
- SPARK_Mode : SPARK_Mode_Type;
- SPARK_Mode_Pragma : Node_Id;
- Uneval_Old : Character;
-diff --git a/gnat/osint.adb b/gnat/osint.adb
-index 0c15982..f78a8ea 100644
---- a/gnat/osint.adb
-+++ b/gnat/osint.adb
-@@ -39,6 +39,7 @@ with Unchecked_Conversion;
- pragma Warnings (Off);
- -- This package is used also by gnatcoll
- with System.Case_Util; use System.Case_Util;
-+with System.CRTL;
- pragma Warnings (On);
-
- with GNAT.HTable;
-@@ -118,10 +119,11 @@ package body Osint is
- -- failure
-
- procedure Find_File
-- (N : File_Name_Type;
-- T : File_Type;
-- Found : out File_Name_Type;
-- Attr : access File_Attributes);
-+ (N : File_Name_Type;
-+ T : File_Type;
-+ Found : out File_Name_Type;
-+ Attr : access File_Attributes;
-+ Full_Name : Boolean := False);
- -- A version of Find_File that also returns a cache of the file attributes
- -- for later reuse
-
-@@ -364,8 +366,9 @@ package body Osint is
-
- S := new String (1 .. Len);
-
-- -- Read the file. Note that the loop is not necessary since the
-- -- whole file is read at once except on VMS.
-+ -- Read the file. Note that the loop is probably not necessary any
-+ -- more since the whole file is read in at once on all targets. But
-+ -- it is harmless and might be needed in future.
-
- Curr := 1;
- Actual_Len := Len;
-@@ -472,31 +475,21 @@ package body Osint is
- Get_Dirs_From_File (Additional_Source_Dir => False);
- end if;
-
-- -- On VMS, don't expand the logical name (e.g. environment variable),
-- -- just put it into Unix (e.g. canonical) format. System services
-- -- will handle the expansion as part of the file processing.
-+ -- Put path name in canonical form
-
- for Additional_Source_Dir in False .. True loop
- if Additional_Source_Dir then
- Search_Path := Getenv (Ada_Include_Path);
-
- if Search_Path'Length > 0 then
-- if Hostparm.OpenVMS then
-- Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
-- else
-- Search_Path := To_Canonical_Path_Spec (Search_Path.all);
-- end if;
-+ Search_Path := To_Canonical_Path_Spec (Search_Path.all);
- end if;
-
- else
- Search_Path := Getenv (Ada_Objects_Path);
-
- if Search_Path'Length > 0 then
-- if Hostparm.OpenVMS then
-- Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
-- else
-- Search_Path := To_Canonical_Path_Spec (Search_Path.all);
-- end if;
-+ Search_Path := To_Canonical_Path_Spec (Search_Path.all);
- end if;
- end if;
-
-@@ -511,9 +504,7 @@ package body Osint is
- -- For the compiler, if --RTS= was specified, add the runtime
- -- directories.
-
-- if RTS_Src_Path_Name /= null
-- and then RTS_Lib_Path_Name /= null
-- then
-+ if RTS_Src_Path_Name /= null and then RTS_Lib_Path_Name /= null then
- Add_Search_Dirs (RTS_Src_Path_Name, Include);
- Add_Search_Dirs (RTS_Lib_Path_Name, Objects);
-
-@@ -732,6 +723,23 @@ package body Osint is
- end if;
- end Create_File_And_Check;
-
-+ -----------------------------------
-+ -- Open_File_To_Append_And_Check --
-+ -----------------------------------
-+
-+ procedure Open_File_To_Append_And_Check
-+ (Fdesc : out File_Descriptor;
-+ Fmode : Mode)
-+ is
-+ begin
-+ Output_File_Name := Name_Enter;
-+ Fdesc := Open_Append (Name_Buffer'Address, Fmode);
-+
-+ if Fdesc = Invalid_FD then
-+ Fail ("Cannot create: " & Name_Buffer (1 .. Name_Len));
-+ end if;
-+ end Open_File_To_Append_And_Check;
-+
- ------------------------
- -- Current_File_Index --
- ------------------------
-@@ -852,13 +860,12 @@ package body Osint is
- Buffer : String := Name_Buffer (1 .. Name_Len);
-
- begin
-- -- Get the file name in canonical case to accept as is names
-- -- ending with ".EXE" on VMS and Windows.
-+ -- Get the file name in canonical case to accept as is. Names
-+ -- end with ".EXE" on Windows.
-
- Canonical_Case_File_Name (Buffer);
-
-- -- If Executable does not end with the executable suffix, add
-- -- it.
-+ -- If Executable doesn't end with the executable suffix, add it
-
- if Buffer'Length <= Exec_Suffix'Length
- or else
-@@ -1076,10 +1083,15 @@ package body Osint is
- function Internal
- (F : Integer;
- N : C_File_Name;
-- A : System.Address) return Long_Integer;
-+ A : System.Address) return CRTL.int64;
- pragma Import (C, Internal, "__gnat_file_length_attr");
-+
- begin
-- return Internal (-1, Name, Attr.all'Address);
-+ -- The conversion from int64 to Long_Integer is ok here as this
-+ -- routine is only to be used by the compiler and we do not expect
-+ -- a unit to be larger than a 32bit integer.
-+
-+ return Long_Integer (Internal (-1, Name, Attr.all'Address));
- end File_Length;
-
- ---------------------
-@@ -1142,13 +1154,14 @@ package body Osint is
- ---------------
-
- function Find_File
-- (N : File_Name_Type;
-- T : File_Type) return File_Name_Type
-+ (N : File_Name_Type;
-+ T : File_Type;
-+ Full_Name : Boolean := False) return File_Name_Type
- is
- Attr : aliased File_Attributes;
- Found : File_Name_Type;
- begin
-- Find_File (N, T, Found, Attr'Access);
-+ Find_File (N, T, Found, Attr'Access, Full_Name);
- return Found;
- end Find_File;
-
-@@ -1157,10 +1170,12 @@ package body Osint is
- ---------------
-
- procedure Find_File
-- (N : File_Name_Type;
-- T : File_Type;
-- Found : out File_Name_Type;
-- Attr : access File_Attributes) is
-+ (N : File_Name_Type;
-+ T : File_Type;
-+ Found : out File_Name_Type;
-+ Attr : access File_Attributes;
-+ Full_Name : Boolean := False)
-+ is
- begin
- Get_Name_String (N);
-
-@@ -1177,15 +1192,24 @@ package body Osint is
-
- if T = Config
- or else (Debug_Generated_Code
-- and then Name_Len > 3
-- and then
-- (Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg"
-- or else
-- (Hostparm.OpenVMS and then
-- Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
-+ and then Name_Len > 3
-+ and then Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg")
- then
- Found := N;
- Attr.all := Unknown_Attributes;
-+
-+ if T = Config and then Full_Name then
-+ declare
-+ Full_Path : constant String :=
-+ Normalize_Pathname (Get_Name_String (N));
-+ Full_Size : constant Natural := Full_Path'Length;
-+ begin
-+ Name_Buffer (1 .. Full_Size) := Full_Path;
-+ Name_Len := Full_Size;
-+ Found := Name_Find;
-+ end;
-+ end if;
-+
- return;
-
- -- If we are trying to find the current main file just look in the
-@@ -1286,21 +1310,6 @@ package body Osint is
- -- Command_Name(Cindex1 .. Cindex2) is now the equivalent of the
- -- POSIX command "basename argv[0]"
-
-- -- Strip off any versioning information such as found on VMS.
-- -- This would take the form of TOOL.exe followed by a ";" or "."
-- -- and a sequence of one or more numbers.
--
-- if Command_Name (Cindex2) in '0' .. '9' then
-- for J in reverse Cindex1 .. Cindex2 loop
-- if Command_Name (J) = '.' or else Command_Name (J) = ';' then
-- Cindex2 := J - 1;
-- exit;
-- end if;
--
-- exit when Command_Name (J) not in '0' .. '9';
-- end loop;
-- end if;
--
- -- Strip off any executable extension (usually nothing or .exe)
- -- but formally reported by autoconf in the variable EXEEXT
-
-@@ -1696,15 +1705,9 @@ package body Osint is
- function Is_Directory_Separator (C : Character) return Boolean is
- begin
- -- In addition to the default directory_separator allow the '/' to
-- -- act as separator since this is allowed in MS-DOS, Windows 95/NT,
-- -- and OS2 ports. On VMS, the situation is more complicated because
-- -- there are two characters to check for.
--
-- return
-- C = Directory_Separator
-- or else C = '/'
-- or else (Hostparm.OpenVMS
-- and then (C = ']' or else C = ':'));
-+ -- act as separator since this is allowed in MS-DOS and Windows.
-+
-+ return C = Directory_Separator or else C = '/';
- end Is_Directory_Separator;
-
- -------------------------
-@@ -2196,11 +2199,7 @@ package body Osint is
-
- function Prep_Suffix return String is
- begin
-- if Hostparm.OpenVMS then
-- return "_prep";
-- else
-- return ".prep";
-- end if;
-+ return ".prep";
- end Prep_Suffix;
-
- ------------------
-@@ -2338,8 +2337,9 @@ package body Osint is
- S := new String (1 .. Len + 1);
- S (Len + 1) := Path_Separator;
-
-- -- Read the file. Note that the loop is not necessary since the
-- -- whole file is read at once except on VMS.
-+ -- Read the file. Note that the loop is probably not necessary since the
-+ -- whole file is read at once but the loop is harmless and that way we
-+ -- are sure to accomodate systems where this is not the case.
-
- Curr := 1;
- Actual_Len := Len;
-@@ -2559,9 +2559,9 @@ package body Osint is
-
- Text := new Text_Buffer (Lo .. Hi);
-
-- -- Some systems (e.g. VMS) have file types that require one
-- -- read per line, so read until we get the Len bytes or until
-- -- there are no more characters.
-+ -- Some systems have file types that require one read per line,
-+ -- so read until we get the Len bytes or until there are no more
-+ -- characters.
-
- Hi := Lo;
- loop
-@@ -2608,7 +2608,7 @@ package body Osint is
- -- For the call to Close
-
- begin
-- Current_Full_Source_Name := Find_File (N, T);
-+ Current_Full_Source_Name := Find_File (N, T, Full_Name => True);
- Current_Full_Source_Stamp := File_Stamp (Current_Full_Source_Name);
-
- if Current_Full_Source_Name = No_File then
-@@ -2642,31 +2642,33 @@ package body Osint is
- return;
- end if;
-
-- -- Print out the file name, if requested, and if it's not part of the
-- -- runtimes, store it in File_Name_Chars.
-+ -- If it's a Source file, print out the file name, if requested, and if
-+ -- it's not part of the runtimes, store it in File_Name_Chars. We don't
-+ -- want to print non-Source files, like GNAT-TEMP-000001.TMP used to
-+ -- pass information from gprbuild to gcc. We don't want to save runtime
-+ -- file names, because we don't want users to send them in bug reports.
-
-- declare
-- Name : String renames Name_Buffer (1 .. Name_Len);
-- Inc : String renames Include_Dir_Default_Prefix.all;
--
-- begin
-- if Debug.Debug_Flag_Dot_N then
-- Write_Line (Name);
-- end if;
-+ if T = Source then
-+ declare
-+ Name : String renames Name_Buffer (1 .. Name_Len);
-+ Inc : String renames Include_Dir_Default_Prefix.all;
-
-- if Inc /= ""
-- and then Inc'Length < Name_Len
-- and then Name_Buffer (1 .. Inc'Length) = Inc
-- then
-- -- Part of runtimes, so ignore it
-+ Part_Of_Runtimes : constant Boolean :=
-+ Inc /= ""
-+ and then Inc'Length < Name_Len
-+ and then Name_Buffer (1 .. Inc'Length) = Inc;
-
-- null;
-+ begin
-+ if Debug.Debug_Flag_Dot_N then
-+ Write_Line (Name);
-+ end if;
-
-- else
-- File_Name_Chars.Append_All (File_Name_Chars.Table_Type (Name));
-- File_Name_Chars.Append (ASCII.LF);
-- end if;
-- end;
-+ if not Part_Of_Runtimes then
-+ File_Name_Chars.Append_All (File_Name_Chars.Table_Type (Name));
-+ File_Name_Chars.Append (ASCII.LF);
-+ end if;
-+ end;
-+ end if;
-
- -- Prepare to read data from the file
-
-@@ -2692,9 +2694,9 @@ package body Osint is
- begin
- -- Allocate source buffer, allowing extra character at end for EOF
-
-- -- Some systems (e.g. VMS) have file types that require one read per
-- -- line, so read until we get the Len bytes or until there are no
-- -- more characters.
-+ -- Some systems have file types that require one read per line,
-+ -- so read until we get the Len bytes or until there are no more
-+ -- characters.
-
- Hi := Lo;
- loop
-@@ -2800,15 +2802,6 @@ package body Osint is
- Library (3 .. 2 + Name'Length) := Name;
- Library (3 + Name'Length) := '-';
- Library (4 + Name'Length .. Library'Last) := Library_Version;
--
-- if OpenVMS_On_Target then
-- for K in Library'First + 2 .. Library'Last loop
-- if Library (K) = '.' or else Library (K) = '-' then
-- Library (K) := '_';
-- end if;
-- end loop;
-- end if;
--
- return Library;
- end Shared_Lib;
-
-diff --git a/gnat/osint.ads b/gnat/osint.ads
-index e1c04c1..eb569c0 100644
---- a/gnat/osint.ads
-+++ b/gnat/osint.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -43,9 +43,9 @@ pragma Elaborate_All (System.OS_Lib);
-
- package Osint is
-
-- Multi_Unit_Index_Character : Character := '~';
-+ Multi_Unit_Index_Character : constant Character := '~';
- -- The character before the index of the unit in a multi-unit source in ALI
-- -- and object file names. Changed to '$' on VMS.
-+ -- and object file names.
-
- Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
- Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
-@@ -63,8 +63,9 @@ package Osint is
- type File_Type is (Source, Library, Config, Definition, Preprocessing_Data);
-
- function Find_File
-- (N : File_Name_Type;
-- T : File_Type) return File_Name_Type;
-+ (N : File_Name_Type;
-+ T : File_Type;
-+ Full_Name : Boolean := False) return File_Name_Type;
- -- Finds a source, library or config file depending on the value of T
- -- following the directory search order rules unless N is the name of the
- -- file just read with Next_Main_File and already contains directory
-@@ -76,6 +77,10 @@ package Osint is
- -- set and the file name ends in ".dg", in which case we look for the
- -- generated file only in the current directory, since that is where it is
- -- always built.
-+ --
-+ -- In the case of configuration files, full path names are needed for some
-+ -- ASIS queries. The flag Full_Name indicates that the name of the file
-+ -- should be normalized to include a full path.
-
- function Get_File_Names_Case_Sensitive return Int;
- pragma Import (C, Get_File_Names_Case_Sensitive,
-@@ -201,33 +206,27 @@ package Osint is
- function To_Canonical_File_List
- (Wildcard_Host_File : String;
- Only_Dirs : Boolean) return String_Access_List_Access;
-- -- Expand a wildcard host syntax file or directory specification (e.g. on
-- -- a VMS host, any file or directory spec that contains: "*", or "%", or
-- -- "...") and return a list of valid Unix syntax file or directory specs.
-- -- If Only_Dirs is True, then only return directories.
-+ -- Expand a wildcard host syntax file or directory specification and return
-+ -- a list of valid Unix syntax file or directory specs. If Only_Dirs is
-+ -- True, then only return directories.
-
- function To_Canonical_Dir_Spec
- (Host_Dir : String;
- Prefix_Style : Boolean) return String_Access;
-- -- Convert a host syntax directory specification (e.g. on a VMS host:
-- -- "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
-- -- If Prefix_Style then make it a valid file specification prefix. A file
-- -- specification prefix is a directory specification that can be appended
-- -- with a simple file specification to yield a valid absolute or relative
-- -- path to a file. On a conversion to Unix syntax this simply means the
-- -- spec has a trailing slash ("/").
-+ -- Convert a host syntax directory specification to canonical (Unix)
-+ -- syntax. If Prefix_Style then make it a valid file specification prefix.
-+ -- A file specification prefix is a directory specification that can be
-+ -- appended with a simple file specification to yield a valid absolute
-+ -- or relative path to a file. On a conversion to Unix syntax this simply
-+ -- means the spec has a trailing slash ("/").
-
- function To_Canonical_File_Spec
- (Host_File : String) return String_Access;
-- -- Convert a host syntax file specification (e.g. on a VMS host:
-- -- "SYS$DEVICE:[DIR]FILE.EXT;69 to canonical (Unix) syntax (e.g.
-- -- "/sys$device/dir/file.ext.69").
-+ -- Convert a host syntax file specification to canonical (Unix) syntax
-
- function To_Canonical_Path_Spec
- (Host_Path : String) return String_Access;
-- -- Convert a host syntax Path specification (e.g. on a VMS host:
-- -- "SYS$DEVICE:[BAR],DISK$USER:[FOO] to canonical (Unix) syntax (e.g.
-- -- "/sys$device/foo:disk$user/foo").
-+ -- Convert a host syntax Path specification to canonical (Unix) syntax
-
- function To_Host_Dir_Spec
- (Canonical_Dir : String;
-@@ -254,7 +253,7 @@ package Osint is
- -- Returns the runtime shared library in the form -l<name>-<version> where
- -- version is the GNAT runtime library option for the platform. For example
- -- this routine called with Name set to "gnat" will return "-lgnat-5.02"
-- -- on UNIX and Windows and -lgnat_5_02 on VMS.
-+ -- on UNIX and Windows.
-
- ---------------------
- -- File attributes --
-@@ -731,6 +730,15 @@ private
- -- parameter is set to either Text or Binary (for details see description
- -- of System.OS_Lib.Create_File).
-
-+ procedure Open_File_To_Append_And_Check
-+ (Fdesc : out File_Descriptor;
-+ Fmode : Mode);
-+ -- Opens the file whose name (NUL terminated) is in Name_Buffer (with the
-+ -- length in Name_Len), and place the resulting descriptor in Fdesc. Issue
-+ -- message and exit with fatal error if file cannot be opened. The Fmode
-+ -- parameter is set to either Text or Binary (for details see description
-+ -- of System.OS_Lib.Open_Append).
-+
- type Program_Type is (Compiler, Binder, Make, Gnatls, Unspecified);
- -- Program currently running
- procedure Set_Program (P : Program_Type);
-diff --git a/gnat/output.adb b/gnat/output.adb
-index c3c90a8..0a73937 100644
---- a/gnat/output.adb
-+++ b/gnat/output.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/output.ads b/gnat/output.ads
-index 7cf2daf..71b25ad 100644
---- a/gnat/output.ads
-+++ b/gnat/output.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -209,11 +209,8 @@ private
-
- Buffer : String (1 .. Buffer_Max + 1) := (others => '*');
- for Buffer'Alignment use 4;
-- -- Buffer used to build output line. We do line buffering because it
-- -- is needed for the support of the debug-generated-code option (-gnatD).
-- -- Historically it was first added because on VMS, line buffering is
-- -- needed with certain file formats. So in any case line buffering must
-- -- be retained for this purpose, even if other reasons disappear. Note
-+ -- Buffer used to build output line. We do line buffering because it is
-+ -- needed for the support of the debug-generated-code option (-gnatD). Note
- -- any attempt to write more output to a line than can fit in the buffer
- -- will be silently ignored. The alignment clause improves the efficiency
- -- of the save/restore procedures.
-diff --git a/gnat/prj-attr-pm.adb b/gnat/prj-attr-pm.adb
-index c2f4518..f9f41b1 100644
---- a/gnat/prj-attr-pm.adb
-+++ b/gnat/prj-attr-pm.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
-+-- Copyright (C) 2004-2014, 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- --
-@@ -47,6 +47,7 @@ package body Prj.Attr.PM is
- Attr_Kind => Unknown,
- Read_Only => False,
- Others_Allowed => False,
-+ Default => Empty_Value,
- Next =>
- Package_Attributes.Table (To_Package.Value).First_Attribute));
-
-diff --git a/gnat/prj-attr.adb b/gnat/prj-attr.adb
-index 04ce48a..201d6b8 100644
---- a/gnat/prj-attr.adb
-+++ b/gnat/prj-attr.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -34,7 +34,7 @@ package body Prj.Attr is
-
- -- Data for predefined attributes and packages
-
-- -- Names are in lower case and end with '#'
-+ -- Names are in lower case and end with '#' or 'D'
-
- -- Package names are preceded by 'P'
-
-@@ -55,11 +55,17 @@ package body Prj.Attr is
- -- 'c' same as 'b', with optional index
-
- -- The third optional letter is
-- -- 'R' to indicate that the attribute is read-only
-- -- 'O' to indicate that others is allowed as an index for an associative
-- -- array
-+ -- 'R' the attribute is read-only
-+ -- 'O' others is allowed as an index for an associative array
-
-- -- End is indicated by two consecutive '#'
-+ -- If the character after the name in lower case letter is a 'D' (for
-+ -- default), then 'D' must be followed by an enumeration value of type
-+ -- Attribute_Default_Value, followed by a '#'.
-+
-+ -- Example:
-+ -- "SVobject_dirDdot_value#"
-+
-+ -- End is indicated by two consecutive '#'.
-
- Initialization_Data : constant String :=
-
-@@ -76,9 +82,9 @@ package body Prj.Attr is
-
- -- Directories
-
-- "SVobject_dir#" &
-- "SVexec_dir#" &
-- "LVsource_dirs#" &
-+ "SVobject_dirDdot_value#" &
-+ "SVexec_dirDobject_dir_value#" &
-+ "LVsource_dirsDdot_value#" &
- "Lainherit_source_path#" &
- "LVexcluded_source_dirs#" &
- "LVignore_source_sub_dirs#" &
-@@ -129,7 +135,8 @@ package body Prj.Attr is
- "Satoolchain_description#" &
- "Saobject_generated#" &
- "Saobjects_linked#" &
-- "SVtarget#" &
-+ "SVtargetDtarget_value#" &
-+ "SaruntimeDruntime_value#" &
-
- -- Configuration - Libraries
-
-@@ -273,9 +280,6 @@ package body Prj.Attr is
- -- Configuration - Linking
-
- "SVdriver#" &
-- "LVexecutable_switch#" &
-- "SVlib_dir_switch#" &
-- "SVlib_name_switch#" &
-
- -- Configuration - Response files
-
-@@ -322,12 +326,6 @@ package body Prj.Attr is
- "Ladefault_switches#" &
- "LbOswitches#" &
-
-- -- package Synchronize
--
-- "Psynchronize#" &
-- "Ladefault_switches#" &
-- "LbOswitches#" &
--
- -- package Eliminate
-
- "Peliminate#" &
-@@ -365,6 +363,8 @@ package body Prj.Attr is
- "SVproject_subdir#" &
- "SVactive#" &
- "LAartifacts#" &
-+ "SVmode#" &
-+ "SVinstall_name#" &
-
- -- package Remote
-
-@@ -416,6 +416,21 @@ package body Prj.Attr is
- Package_Names (Last_Package_Name) := new String'(Name);
- end Add_Package_Name;
-
-+ --------------------------
-+ -- Attribute_Default_Of --
-+ --------------------------
-+
-+ function Attribute_Default_Of
-+ (Attribute : Attribute_Node_Id) return Attribute_Default_Value
-+ is
-+ begin
-+ if Attribute = Empty_Attribute then
-+ return Empty_Value;
-+ else
-+ return Attrs.Table (Attribute.Value).Default;
-+ end if;
-+ end Attribute_Default_Of;
-+
- -----------------------
- -- Attribute_Kind_Of --
- -----------------------
-@@ -482,6 +497,7 @@ package body Prj.Attr is
- First_Attribute : Attr_Node_Id := Attr.First_Attribute;
- Read_Only : Boolean;
- Others_Allowed : Boolean;
-+ Default : Attribute_Default_Value;
-
- function Attribute_Location return String;
- -- Returns a string depending if we are in the project level attributes
-@@ -611,9 +627,11 @@ package body Prj.Attr is
-
- Read_Only := False;
- Others_Allowed := False;
-+ Default := Empty_Value;
-
- if Initialization_Data (Start) = 'R' then
- Read_Only := True;
-+ Default := Read_Only_Value;
- Start := Start + 1;
-
- elsif Initialization_Data (Start) = 'O' then
-@@ -623,12 +641,40 @@ package body Prj.Attr is
-
- Finish := Start;
-
-- while Initialization_Data (Finish) /= '#' loop
-+ while Initialization_Data (Finish) /= '#'
-+ and then
-+ Initialization_Data (Finish) /= 'D'
-+ loop
- Finish := Finish + 1;
- end loop;
-
- Attribute_Name :=
- Name_Id_Of (Initialization_Data (Start .. Finish - 1));
-+
-+ if Initialization_Data (Finish) = 'D' then
-+ Start := Finish + 1;
-+
-+ Finish := Start;
-+ while Initialization_Data (Finish) /= '#' loop
-+ Finish := Finish + 1;
-+ end loop;
-+
-+ declare
-+ Default_Name : constant String :=
-+ Initialization_Data (Start .. Finish - 1);
-+ pragma Unsuppress (All_Checks);
-+ begin
-+ Default := Attribute_Default_Value'Value (Default_Name);
-+ exception
-+ when Constraint_Error =>
-+ Osint.Fail
-+ ("illegal default value """ &
-+ Default_Name &
-+ """ for attribute " &
-+ Get_Name_String (Attribute_Name));
-+ end;
-+ end if;
-+
- Attrs.Increment_Last;
-
- if Current_Attribute = Empty_Attr then
-@@ -662,6 +708,7 @@ package body Prj.Attr is
- Attr_Kind => Attr_Kind,
- Read_Only => Read_Only,
- Others_Allowed => Others_Allowed,
-+ Default => Default,
- Next => Empty_Attr);
- Start := Finish + 1;
- end if;
-@@ -769,8 +816,9 @@ package body Prj.Attr is
- In_Package : Package_Node_Id;
- Attr_Kind : Defined_Attribute_Kind;
- Var_Kind : Defined_Variable_Kind;
-- Index_Is_File_Name : Boolean := False;
-- Opt_Index : Boolean := False)
-+ Index_Is_File_Name : Boolean := False;
-+ Opt_Index : Boolean := False;
-+ Default : Attribute_Default_Value := Empty_Value)
- is
- Attr_Name : Name_Id;
- First_Attr : Attr_Node_Id := Empty_Attr;
-@@ -840,6 +888,7 @@ package body Prj.Attr is
- Attr_Kind => Real_Attr_Kind,
- Read_Only => False,
- Others_Allowed => False,
-+ Default => Default,
- Next => First_Attr);
-
- Package_Attributes.Table (In_Package.Value).First_Attribute :=
-@@ -852,6 +901,7 @@ package body Prj.Attr is
-
- procedure Register_New_Package (Name : String; Id : out Package_Node_Id) is
- Pkg_Name : Name_Id;
-+ Found : Boolean := False;
-
- begin
- if Name'Length = 0 then
-@@ -864,17 +914,27 @@ package body Prj.Attr is
-
- for Index in Package_Attributes.First .. Package_Attributes.Last loop
- if Package_Attributes.Table (Index).Name = Pkg_Name then
-- Fail ("cannot register a package with a non unique name """
-- & Name
-- & """");
-- Id := Empty_Package;
-- return;
-+ if Package_Attributes.Table (Index).Known then
-+ Fail ("cannot register a package with a non unique name """
-+ & Name
-+ & """");
-+ Id := Empty_Package;
-+ return;
-+
-+ else
-+ Found := True;
-+ Id := (Value => Index);
-+ exit;
-+ end if;
- end if;
- end loop;
-
-- Package_Attributes.Increment_Last;
-- Id := (Value => Package_Attributes.Last);
-- Package_Attributes.Table (Package_Attributes.Last) :=
-+ if not Found then
-+ Package_Attributes.Increment_Last;
-+ Id := (Value => Package_Attributes.Last);
-+ end if;
-+
-+ Package_Attributes.Table (Id.Value) :=
- (Name => Pkg_Name,
- Known => True,
- First_Attribute => Empty_Attr);
-@@ -952,6 +1012,7 @@ package body Prj.Attr is
- Attr_Kind => Attr_Kind,
- Read_Only => False,
- Others_Allowed => False,
-+ Default => Attributes (Index).Default,
- Next => First_Attr);
- First_Attr := Attrs.Last;
- end loop;
-diff --git a/gnat/prj-attr.ads b/gnat/prj-attr.ads
-index dc60cd6..e821a82 100644
---- a/gnat/prj-attr.ads
-+++ b/gnat/prj-attr.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -107,6 +107,10 @@ package Prj.Attr is
- Var_Kind : Defined_Variable_Kind;
- -- The attribute value kind: single or list
-
-+ Default : Attribute_Default_Value := Empty_Value;
-+ -- The value of the attribute when referenced if the attribute has not
-+ -- yet been declared.
-+
- end record;
- -- Name and characteristics of an attribute in a package registered
- -- explicitly with Register_New_Package (see below).
-@@ -190,6 +194,11 @@ package Prj.Attr is
- -- Set the variable kind of a known attribute. Does nothing if Attribute is
- -- Empty_Attribute.
-
-+ function Attribute_Default_Of
-+ (Attribute : Attribute_Node_Id) return Attribute_Default_Value;
-+ -- Returns the default of the attribute, Read_Only_Value for read only
-+ -- attributes, Empty_Value when default not specified, or specified value.
-+
- function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
- -- Returns True if Attribute is a known attribute and may have an
- -- optional index. Returns False otherwise.
-@@ -231,13 +240,14 @@ package Prj.Attr is
- In_Package : Package_Node_Id;
- Attr_Kind : Defined_Attribute_Kind;
- Var_Kind : Defined_Variable_Kind;
-- Index_Is_File_Name : Boolean := False;
-- Opt_Index : Boolean := False);
-+ Index_Is_File_Name : Boolean := False;
-+ Opt_Index : Boolean := False;
-+ Default : Attribute_Default_Value := Empty_Value);
- -- Add a new attribute to registered package In_Package. Fails if Name
- -- (the attribute name) is empty, if In_Package is Empty_Package or if
- -- the attribute name has a duplicate name. See definition of type
- -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
-- -- Index_Is_File_Name and Opt_Index.
-+ -- Index_Is_File_Name, Opt_Index, and Default.
-
- function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
- -- Returns the package node id of the package with name Name. Returns
-@@ -320,6 +330,7 @@ private
- Attr_Kind : Attribute_Kind;
- Read_Only : Boolean;
- Others_Allowed : Boolean;
-+ Default : Attribute_Default_Value;
- Next : Attr_Node_Id;
- end record;
- -- Data for an attribute
-diff --git a/gnat/prj-conf.adb b/gnat/prj-conf.adb
-index 1becd70..9c83902 100644
---- a/gnat/prj-conf.adb
-+++ b/gnat/prj-conf.adb
-@@ -23,7 +23,6 @@
- -- --
- ------------------------------------------------------------------------------
-
--with Hostparm;
- with Makeutl; use Makeutl;
- with MLib.Tgt;
- with Opt; use Opt;
-@@ -54,6 +53,32 @@ package body Prj.Conf is
-
- Gprconfig_Name : constant String := "gprconfig";
-
-+ Warn_For_RTS : Boolean := True;
-+ -- Set to False when gprbuild parse again the project files, to avoid
-+ -- an incorrect warning.
-+
-+ type Runtime_Root_Data;
-+ type Runtime_Root_Ptr is access Runtime_Root_Data;
-+ type Runtime_Root_Data is record
-+ Root : String_Access;
-+ Next : Runtime_Root_Ptr;
-+ end record;
-+ -- Data for a runtime root to be used when adding directories to the
-+ -- project path.
-+
-+ type Compiler_Root_Data;
-+ type Compiler_Root_Ptr is access Compiler_Root_Data;
-+ type Compiler_Root_Data is record
-+ Root : String_Access;
-+ Runtimes : Runtime_Root_Ptr;
-+ Next : Compiler_Root_Ptr;
-+ end record;
-+ -- Data for a compiler root to be used when adding directories to the
-+ -- project path.
-+
-+ First_Compiler_Root : Compiler_Root_Ptr := null;
-+ -- Head of the list of compiler roots
-+
- package RTS_Languages is new GNAT.HTable.Simple_HTable
- (Header_Num => Prj.Header_Num,
- Element => Name_Id,
-@@ -99,6 +124,21 @@ package body Prj.Conf is
- -- projects, so that when the second phase of the processing is performed
- -- these attributes are automatically taken into account.
-
-+ type State is (No_State);
-+
-+ procedure Look_For_Project_Paths
-+ (Project : Project_Id;
-+ Tree : Project_Tree_Ref;
-+ With_State : in out State);
-+ -- Check the compilers in the Project and add record them in the list
-+ -- rooted at First_Compiler_Root, with their runtimes, if they are not
-+ -- already in the list.
-+
-+ procedure Update_Project_Path is new
-+ For_Every_Project_Imported
-+ (State => State,
-+ Action => Look_For_Project_Paths);
-+
- ------------------------------------
- -- Add_Default_GNAT_Naming_Scheme --
- ------------------------------------
-@@ -165,7 +205,7 @@ package body Prj.Conf is
- begin
- if Config_File = Empty_Node then
-
-- -- Create a dummy config file is none was found
-+ -- Create a dummy config file if none was found
-
- Name_Len := Auto_Cgpr'Length;
- Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
-@@ -580,7 +620,7 @@ package body Prj.Conf is
- or else
- (Tgt_Name /= No_Name
- and then (Length_Of_Name (Tgt_Name) = 0
-- or else Target = Get_Name_String (Tgt_Name)));
-+ or else Target = Get_Name_String (Tgt_Name)));
-
- if not OK then
- if Autoconf_Specified then
-@@ -593,8 +633,9 @@ package body Prj.Conf is
- else
- if Tgt_Name /= No_Name then
- Raise_Invalid_Config
-- ("invalid target name """
-- & Get_Name_String (Tgt_Name) & """ in configuration");
-+ ("mismatched targets: """
-+ & Get_Name_String (Tgt_Name) & """ in configuration, """
-+ & Target & """ specified");
- else
- Raise_Invalid_Config
- ("no target specified in configuration file");
-@@ -652,6 +693,10 @@ package body Prj.Conf is
- -- If Target_Name is empty, get the specified target in the project
- -- file, if any.
-
-+ procedure Get_Project_Runtimes;
-+ -- Get the various Runtime (<lang>) in the project file or any project
-+ -- it extends, if any are specified.
-+
- function Get_Config_Switches return Argument_List_Access;
- -- Return the --config switches to use for gprconfig
-
-@@ -721,7 +766,6 @@ package body Prj.Conf is
- Set_Runtime_For
- (Name_Ada,
- Name_Buffer (7 .. Name_Len));
-- Locate_Runtime (Name_Ada, Project_Tree, Env);
- end if;
-
- elsif Name_Len > 7
-@@ -748,7 +792,6 @@ package body Prj.Conf is
-
- if not Runtime_Name_Set_For (Lang) then
- Set_Runtime_For (Lang, RTS);
-- Locate_Runtime (Lang, Project_Tree, Env);
- end if;
- end;
- end if;
-@@ -825,6 +868,36 @@ package body Prj.Conf is
- end if;
- end Get_Project_Target;
-
-+ --------------------------
-+ -- Get_Project_Runtimes --
-+ --------------------------
-+
-+ procedure Get_Project_Runtimes is
-+ Element : Array_Element;
-+ Id : Array_Element_Id;
-+ Lang : Name_Id;
-+ Proj : Project_Id;
-+
-+ begin
-+ Proj := Project;
-+ while Proj /= No_Project loop
-+ Id := Value_Of (Name_Runtime, Proj.Decl.Arrays, Shared);
-+ while Id /= No_Array_Element loop
-+ Element := Shared.Array_Elements.Table (Id);
-+ Lang := Element.Index;
-+
-+ if not Runtime_Name_Set_For (Lang) then
-+ Set_Runtime_For
-+ (Lang, RTS_Name => Get_Name_String (Element.Value.Value));
-+ end if;
-+
-+ Id := Element.Next;
-+ end loop;
-+
-+ Proj := Proj.Extends;
-+ end loop;
-+ end Get_Project_Runtimes;
-+
- -----------------------
- -- Default_File_Name --
- -----------------------
-@@ -973,7 +1046,7 @@ package body Prj.Conf is
- end if;
-
- -- Get the config switches. This should be done only now, as some
-- -- runtimes may have been found if the Builder switches.
-+ -- runtimes may have been found in the Builder switches.
-
- Config_Switches := Get_Config_Switches;
-
-@@ -1029,21 +1102,21 @@ package body Prj.Conf is
- Args (3) := Conf_File_Name;
- end if;
-
-- if Normalized_Hostname = "" then
-- Arg_Last := 3;
-- else
-- if Selected_Target'Length = 0 then
-- if At_Least_One_Compiler_Command then
-- Args (4) :=
-- new String'("--target=all");
-- else
-- Args (4) :=
-- new String'("--target=" & Normalized_Hostname);
-- end if;
-+ Arg_Last := 3;
-
-+ if Selected_Target /= null and then
-+ Selected_Target.all /= ""
-+
-+ then
-+ Args (4) :=
-+ new String'("--target=" & Selected_Target.all);
-+ Arg_Last := 4;
-+
-+ elsif Normalized_Hostname /= "" then
-+ if At_Least_One_Compiler_Command then
-+ Args (4) := new String'("--target=all");
- else
-- Args (4) :=
-- new String'("--target=" & Selected_Target.all);
-+ Args (4) := new String'("--target=" & Normalized_Hostname);
- end if;
-
- Arg_Last := 4;
-@@ -1075,12 +1148,11 @@ package body Prj.Conf is
- Write_Eol;
-
- elsif not Quiet_Output then
-+
- -- Display no message if we are creating auto.cgpr, unless in
-- -- verbose mode
-+ -- verbose mode.
-
-- if Config_File_Name'Length > 0
-- or else Verbose_Mode
-- then
-+ if Config_File_Name'Length > 0 or else Verbose_Mode then
- Write_Str ("creating ");
- Write_Str (Simple_Name (Args (3).all));
- Write_Eol;
-@@ -1293,11 +1365,14 @@ package body Prj.Conf is
- Config_Command : constant String :=
- "--config=" & Get_Name_String (Name);
-
-- Runtime_Name : constant String :=
-- Runtime_Name_For (Name);
-+ Runtime_Name : constant String := Runtime_Name_For (Name);
-
- begin
-- if Variable = Nil_Variable_Value
-+ -- In CodePeer mode, we do not take into account any compiler
-+ -- command from the package IDE.
-+
-+ if CodePeer_Mode
-+ or else Variable = Nil_Variable_Value
- or else Length_Of_Name (Variable.Value) = 0
- then
- Result (Count) :=
-@@ -1314,14 +1389,14 @@ package body Prj.Conf is
- if Is_Absolute_Path (Compiler_Command) then
- Result (Count) :=
- new String'
-- (Config_Command & ",," & Runtime_Name & "," &
-- Containing_Directory (Compiler_Command) & "," &
-- Simple_Name (Compiler_Command));
-+ (Config_Command & ",," & Runtime_Name & ","
-+ & Containing_Directory (Compiler_Command) & ","
-+ & Simple_Name (Compiler_Command));
- else
- Result (Count) :=
- new String'
-- (Config_Command & ",," & Runtime_Name & ",," &
-- Compiler_Command);
-+ (Config_Command & ",," & Runtime_Name & ",,"
-+ & Compiler_Command);
- end if;
- end;
- end if;
-@@ -1343,20 +1418,14 @@ package body Prj.Conf is
-
- begin
- Variable :=
-- Value_Of
-- (Name_Source_Dirs,
-- Project.Decl.Attributes,
-- Shared);
-+ Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared);
-
- if Variable = Nil_Variable_Value
- or else Variable.Default
- or else Variable.Values /= Nil_String
- then
- Variable :=
-- Value_Of
-- (Name_Source_Files,
-- Project.Decl.Attributes,
-- Shared);
-+ Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared);
- return Variable = Nil_Variable_Value
- or else Variable.Default
- or else Variable.Values /= Nil_String;
-@@ -1366,9 +1435,13 @@ package body Prj.Conf is
- end if;
- end Might_Have_Sources;
-
-+ -- Local Variables
-+
- Success : Boolean;
- Config_Project_Node : Project_Node_Id := Empty_Node;
-
-+ -- Start of processing for Get_Or_Create_Configuration_File
-+
- begin
- pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
-
-@@ -1376,6 +1449,7 @@ package body Prj.Conf is
- Config := No_Project;
-
- Get_Project_Target;
-+ Get_Project_Runtimes;
- Check_Builder_Switches;
-
- -- Do not attempt to find a configuration project file when
-@@ -1408,29 +1482,22 @@ package body Prj.Conf is
- <<Process_Config_File>>
-
- if Automatically_Generated then
-- if Hostparm.OpenVMS then
--
-- -- There is no gprconfig on VMS
-
-- Raise_Invalid_Config
-- ("could not locate any configuration project file");
-+ -- This might raise an Invalid_Config exception
-
-- else
-- -- This might raise an Invalid_Config exception
--
-- Do_Autoconf;
-- end if;
-+ Do_Autoconf;
-
- -- If the config file is not auto-generated, warn if there is any --RTS
- -- switch, but not when the config file is generated in memory.
-
-- elsif RTS_Languages.Get_First /= No_Name
-+ elsif Warn_For_RTS
-+ and then RTS_Languages.Get_First /= No_Name
- and then Opt.Warning_Mode /= Opt.Suppress
- and then On_Load_Config = null
- then
- Write_Line
- ("warning: " &
-- "--RTS is taken into account only in auto-configuration");
-+ "runtimes are taken into account only in auto-configuration");
- end if;
-
- -- Parse the configuration file
-@@ -1473,9 +1540,7 @@ package body Prj.Conf is
- On_New_Tree_Loaded => null);
- end if;
-
-- if Config_Project_Node = Empty_Node
-- or else Config = No_Project
-- then
-+ if Config_Project_Node = Empty_Node or else Config = No_Project then
- Raise_Invalid_Config
- ("processing of configuration project """
- & Config_File_Path.all & """ failed");
-@@ -1512,57 +1577,6 @@ package body Prj.Conf is
- end if;
- end Locate_Config_File;
-
-- --------------------
-- -- Locate_Runtime --
-- --------------------
--
-- procedure Locate_Runtime
-- (Language : Name_Id;
-- Project_Tree : Prj.Project_Tree_Ref;
-- Env : Prj.Tree.Environment)
-- is
-- function Is_Base_Name (Path : String) return Boolean;
-- -- Returns True if Path has no directory separator
--
-- ------------------
-- -- Is_Base_Name --
-- ------------------
--
-- function Is_Base_Name (Path : String) return Boolean is
-- begin
-- for I in Path'Range loop
-- if Path (I) = Directory_Separator or else Path (I) = '/' then
-- return False;
-- end if;
-- end loop;
-- return True;
-- end Is_Base_Name;
--
-- -- Local declarations
--
-- function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
-- (Check_Filename => Is_Directory);
--
-- RTS_Name : constant String := Runtime_Name_For (Language);
--
-- Full_Path : String_Access;
--
-- -- Start of processing for Locate_Runtime
--
-- begin
-- if not Is_Base_Name (RTS_Name) then
-- Full_Path :=
-- Find_Rts_In_Path (Env.Project_Path, RTS_Name);
--
-- if Full_Path = null then
-- Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name);
-- end if;
--
-- Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all));
-- Free (Full_Path);
-- end if;
-- end Locate_Runtime;
--
- ------------------------------------
- -- Parse_Project_And_Apply_Config --
- ------------------------------------
-@@ -1586,48 +1600,347 @@ package body Prj.Conf is
- Implicit_Project : Boolean := False;
- On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
- is
-+ Success : Boolean := False;
-+ Target_Try_Again : Boolean := True;
-+ Config_Try_Again : Boolean;
-+
-+ Finalization : Prj.Part.Errout_Mode := Prj.Part.Always_Finalize;
-+
-+ S : State := No_State;
-+
-+ Conf_File_Name : String_Access := new String'(Config_File_Name);
-+
-+ procedure Add_Directory (Dir : String);
-+ -- Add a directory at the end of the Project Path
-+
-+ Auto_Generated : Boolean;
-+
-+ -------------------
-+ -- Add_Directory --
-+ -------------------
-+
-+ procedure Add_Directory (Dir : String) is
-+ begin
-+ if Opt.Verbose_Mode then
-+ Write_Line (" Adding directory """ & Dir & """");
-+ end if;
-+
-+ Prj.Env.Add_Directories (Env.Project_Path, Dir);
-+ end Add_Directory;
-+
- begin
- pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
-
-+ -- Start with ignoring missing withed projects
-+
-+ Set_Ignore_Missing_With (Env.Flags, True);
-+
-+ -- Note: If in fact the config file is automatically generated, then
-+ -- Automatically_Generated will be set to True after invocation of
-+ -- Process_Project_And_Apply_Config.
-+
-+ Automatically_Generated := False;
-+
-+ -- Record Target_Value and Target_Origin
-+
-+ if Target_Name = "" then
-+ Opt.Target_Value := new String'(Normalized_Hostname);
-+ Opt.Target_Origin := Default;
-+ else
-+ Opt.Target_Value := new String'(Target_Name);
-+ Opt.Target_Origin := Specified;
-+ end if;
-+
-+ <<Parse_Again>>
-+
- -- Parse the user project tree
-
-+ Project_Node_Tree.Incomplete_With := False;
-+ Env.Flags.Incomplete_Withs := False;
- Prj.Initialize (Project_Tree);
-
- Main_Project := No_Project;
-- Automatically_Generated := False;
-
- Prj.Part.Parse
- (In_Tree => Project_Node_Tree,
- Project => User_Project_Node,
- Project_File_Name => Project_File_Name,
-- Errout_Handling => Prj.Part.Finalize_If_Error,
-+ Errout_Handling => Finalization,
- Packages_To_Check => Packages_To_Check,
- Current_Directory => Current_Directory,
- Is_Config_File => False,
- Env => Env,
- Implicit_Project => Implicit_Project);
-
-+ Finalization := Prj.Part.Finalize_If_Error;
-+
- if User_Project_Node = Empty_Node then
-- User_Project_Node := Empty_Node;
- return;
- end if;
-
-+ -- If --target was not specified on the command line, then do Phase 1 to
-+ -- check if attribute Target is declared in the main project.
-+
-+ if Opt.Target_Origin /= Specified then
-+ Main_Project := No_Project;
-+ Process_Project_Tree_Phase_1
-+ (In_Tree => Project_Tree,
-+ Project => Main_Project,
-+ Packages_To_Check => Packages_To_Check,
-+ Success => Success,
-+ From_Project_Node => User_Project_Node,
-+ From_Project_Node_Tree => Project_Node_Tree,
-+ Env => Env,
-+ Reset_Tree => True,
-+ On_New_Tree_Loaded => On_New_Tree_Loaded);
-+
-+ if not Success then
-+ Main_Project := No_Project;
-+ return;
-+ end if;
-+
-+ declare
-+ Variable : constant Variable_Value :=
-+ Value_Of
-+ (Name_Target,
-+ Main_Project.Decl.Attributes,
-+ Project_Tree.Shared);
-+ begin
-+ if Variable /= Nil_Variable_Value
-+ and then not Variable.Default
-+ and then
-+ Get_Name_String (Variable.Value) /= Opt.Target_Value.all
-+ then
-+ if Target_Try_Again then
-+ Opt.Target_Value :=
-+ new String'(Get_Name_String (Variable.Value));
-+ Target_Try_Again := False;
-+ goto Parse_Again;
-+
-+ else
-+ Fail_Program
-+ (Project_Tree,
-+ "inconsistent value of attribute Target");
-+ end if;
-+ end if;
-+ end;
-+ end if;
-+
-+ -- If there are missing withed projects, the projects will be parsed
-+ -- again after the project path is extended with directories rooted
-+ -- at the compiler roots.
-+
-+ Config_Try_Again := Project_Node_Tree.Incomplete_With;
-+
- Process_Project_And_Apply_Config
- (Main_Project => Main_Project,
- User_Project_Node => User_Project_Node,
-- Config_File_Name => Config_File_Name,
-+ Config_File_Name => Conf_File_Name.all,
- Autoconf_Specified => Autoconf_Specified,
- Project_Tree => Project_Tree,
- Project_Node_Tree => Project_Node_Tree,
- Env => Env,
- Packages_To_Check => Packages_To_Check,
- Allow_Automatic_Generation => Allow_Automatic_Generation,
-- Automatically_Generated => Automatically_Generated,
-+ Automatically_Generated => Auto_Generated,
- Config_File_Path => Config_File_Path,
- Target_Name => Target_Name,
- Normalized_Hostname => Normalized_Hostname,
- On_Load_Config => On_Load_Config,
-- On_New_Tree_Loaded => On_New_Tree_Loaded);
-+ On_New_Tree_Loaded => On_New_Tree_Loaded,
-+ Do_Phase_1 => Opt.Target_Origin = Specified);
-+
-+ if Auto_Generated then
-+ Automatically_Generated := True;
-+ end if;
-+
-+ -- Exit if there was an error. Otherwise, if Config_Try_Again is True,
-+ -- update the project path and try again.
-+
-+ if Main_Project /= No_Project and then Config_Try_Again then
-+ Set_Ignore_Missing_With (Env.Flags, False);
-+
-+ if Config_File_Path /= null then
-+ Conf_File_Name := new String'(Config_File_Path.all);
-+ end if;
-+
-+ -- For the second time the project files are parsed, the warning for
-+ -- --RTS= being only taken into account in auto-configuration are
-+ -- suppressed, as we are no longer in auto-configuration.
-+
-+ Warn_For_RTS := False;
-+
-+ -- Add the default directories corresponding to the compilers
-+
-+ Update_Project_Path
-+ (By => Main_Project,
-+ Tree => Project_Tree,
-+ With_State => S,
-+ Include_Aggregated => True,
-+ Imported_First => False);
-+
-+ declare
-+ Compiler_Root : Compiler_Root_Ptr;
-+ Prefix : String_Access;
-+ Runtime_Root : Runtime_Root_Ptr;
-+ Path_Value : constant String_Access := Getenv ("PATH");
-+
-+ begin
-+ if Opt.Verbose_Mode then
-+ Write_Line ("Setting the default project search directories");
-+
-+ if Prj.Current_Verbosity = High then
-+ if Path_Value = null or else Path_Value'Length = 0 then
-+ Write_Line ("No environment variable PATH");
-+
-+ else
-+ Write_Line ("PATH =");
-+ Write_Line (" " & Path_Value.all);
-+ end if;
-+ end if;
-+ end if;
-+
-+ -- Reorder the compiler roots in the PATH order
-+
-+ if First_Compiler_Root /= null
-+ and then First_Compiler_Root.Next /= null
-+ then
-+ declare
-+ Pred : Compiler_Root_Ptr;
-+ First_New_Comp : Compiler_Root_Ptr := null;
-+ New_Comp : Compiler_Root_Ptr := null;
-+ First : Positive := Path_Value'First;
-+ Last : Positive;
-+ Path_Last : Positive;
-+ begin
-+ while First <= Path_Value'Last loop
-+ Last := First;
-+
-+ if Path_Value (First) /= Path_Separator then
-+ while Last < Path_Value'Last
-+ and then Path_Value (Last + 1) /= Path_Separator
-+ loop
-+ Last := Last + 1;
-+ end loop;
-+
-+ Path_Last := Last;
-+ while Path_Last > First
-+ and then
-+ Path_Value (Path_Last) = Directory_Separator
-+ loop
-+ Path_Last := Path_Last - 1;
-+ end loop;
-+
-+ if Path_Last > First + 4
-+ and then
-+ Path_Value (Path_Last - 2 .. Path_Last) = "bin"
-+ and then
-+ Path_Value (Path_Last - 3) = Directory_Separator
-+ then
-+ Path_Last := Path_Last - 4;
-+ Pred := null;
-+ Compiler_Root := First_Compiler_Root;
-+ while Compiler_Root /= null
-+ and then Compiler_Root.Root.all /=
-+ Path_Value (First .. Path_Last)
-+ loop
-+ Pred := Compiler_Root;
-+ Compiler_Root := Compiler_Root.Next;
-+ end loop;
-+
-+ if Compiler_Root /= null then
-+ if Pred = null then
-+ First_Compiler_Root :=
-+ First_Compiler_Root.Next;
-+ else
-+ Pred.Next := Compiler_Root.Next;
-+ end if;
-+
-+ if First_New_Comp = null then
-+ First_New_Comp := Compiler_Root;
-+ else
-+ New_Comp.Next := Compiler_Root;
-+ end if;
-+
-+ New_Comp := Compiler_Root;
-+ New_Comp.Next := null;
-+ end if;
-+ end if;
-+ end if;
-+
-+ First := Last + 1;
-+ end loop;
-+
-+ if First_New_Comp /= null then
-+ New_Comp.Next := First_Compiler_Root;
-+ First_Compiler_Root := First_New_Comp;
-+ end if;
-+ end;
-+ end if;
-+
-+ -- Now that the compiler roots are in a correct order, add the
-+ -- directories corresponding to these compiler roots in the
-+ -- project path.
-+
-+ Compiler_Root := First_Compiler_Root;
-+ while Compiler_Root /= null loop
-+ Prefix := Compiler_Root.Root;
-+
-+ Runtime_Root := Compiler_Root.Runtimes;
-+ while Runtime_Root /= null loop
-+ Add_Directory
-+ (Runtime_Root.Root.all &
-+ Directory_Separator &
-+ "lib" &
-+ Directory_Separator &
-+ "gnat");
-+ Add_Directory
-+ (Runtime_Root.Root.all &
-+ Directory_Separator &
-+ "share" &
-+ Directory_Separator &
-+ "gpr");
-+ Runtime_Root := Runtime_Root.Next;
-+ end loop;
-+
-+ Add_Directory
-+ (Prefix.all &
-+ Directory_Separator &
-+ Opt.Target_Value.all &
-+ Directory_Separator &
-+ "lib" &
-+ Directory_Separator &
-+ "gnat");
-+ Add_Directory
-+ (Prefix.all &
-+ Directory_Separator &
-+ Opt.Target_Value.all &
-+ Directory_Separator &
-+ "share" &
-+ Directory_Separator &
-+ "gpr");
-+ Add_Directory
-+ (Prefix.all &
-+ Directory_Separator &
-+ "share" &
-+ Directory_Separator &
-+ "gpr");
-+ Add_Directory
-+ (Prefix.all &
-+ Directory_Separator &
-+ "lib" &
-+ Directory_Separator &
-+ "gnat");
-+ Compiler_Root := Compiler_Root.Next;
-+ end loop;
-+ end;
-+
-+ -- And parse again the project files. There will be no missing
-+ -- withed projects, as Ignore_Missing_With is set to False in
-+ -- the environment flags, so there is no risk of endless loop here.
-+
-+ goto Parse_Again;
-+ end if;
- end Parse_Project_And_Apply_Config;
-
- --------------------------------------
-@@ -1650,7 +1963,8 @@ package body Prj.Conf is
- Normalized_Hostname : String;
- On_Load_Config : Config_File_Hook := null;
- Reset_Tree : Boolean := True;
-- On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
-+ On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null;
-+ Do_Phase_1 : Boolean := True)
- is
- Shared : constant Shared_Project_Tree_Data_Access :=
- Project_Tree.Shared;
-@@ -1695,23 +2009,25 @@ package body Prj.Conf is
- -- Start of processing for Process_Project_And_Apply_Config
-
- begin
-- Main_Project := No_Project;
- Automatically_Generated := False;
-
-- Process_Project_Tree_Phase_1
-- (In_Tree => Project_Tree,
-- Project => Main_Project,
-- Packages_To_Check => Packages_To_Check,
-- Success => Success,
-- From_Project_Node => User_Project_Node,
-- From_Project_Node_Tree => Project_Node_Tree,
-- Env => Env,
-- Reset_Tree => Reset_Tree,
-- On_New_Tree_Loaded => On_New_Tree_Loaded);
--
-- if not Success then
-+ if Do_Phase_1 then
- Main_Project := No_Project;
-- return;
-+ Process_Project_Tree_Phase_1
-+ (In_Tree => Project_Tree,
-+ Project => Main_Project,
-+ Packages_To_Check => Packages_To_Check,
-+ Success => Success,
-+ From_Project_Node => User_Project_Node,
-+ From_Project_Node_Tree => Project_Node_Tree,
-+ Env => Env,
-+ Reset_Tree => Reset_Tree,
-+ On_New_Tree_Loaded => On_New_Tree_Loaded);
-+
-+ if not Success then
-+ Main_Project := No_Project;
-+ return;
-+ end if;
- end if;
-
- if Project_Tree.Source_Info_File_Name /= null then
-@@ -1848,4 +2164,113 @@ package body Prj.Conf is
- RTS_Languages.Set (Language, Name_Find);
- end Set_Runtime_For;
-
-+ ----------------------------
-+ -- Look_For_Project_Paths --
-+ ----------------------------
-+
-+ procedure Look_For_Project_Paths
-+ (Project : Project_Id;
-+ Tree : Project_Tree_Ref;
-+ With_State : in out State)
-+ is
-+ Lang_Id : Language_Ptr;
-+ Compiler_Root : Compiler_Root_Ptr;
-+ Runtime_Root : Runtime_Root_Ptr;
-+ Comp_Driver : String_Access;
-+ Comp_Dir : String_Access;
-+ Prefix : String_Access;
-+
-+ pragma Unreferenced (Tree);
-+
-+ begin
-+ With_State := No_State;
-+
-+ Lang_Id := Project.Languages;
-+ while Lang_Id /= No_Language_Index loop
-+ if Lang_Id.Config.Compiler_Driver /= No_File then
-+ Comp_Driver :=
-+ new String'
-+ (Get_Name_String (Lang_Id.Config.Compiler_Driver));
-+
-+ -- Get the absolute path of the compiler driver
-+
-+ if not Is_Absolute_Path (Comp_Driver.all) then
-+ Comp_Driver := Locate_Exec_On_Path (Comp_Driver.all);
-+ end if;
-+
-+ if Comp_Driver /= null and then Comp_Driver'Length > 0 then
-+ Comp_Dir :=
-+ new String'
-+ (Containing_Directory (Comp_Driver.all));
-+
-+ -- Consider only the compiler drivers that are in "bin"
-+ -- subdirectories.
-+
-+ if Simple_Name (Comp_Dir.all) = "bin" then
-+ Prefix :=
-+ new String'(Containing_Directory (Comp_Dir.all));
-+
-+ -- Check if the compiler root is already in the list. If it
-+ -- is not, add it to the list.
-+
-+ Compiler_Root := First_Compiler_Root;
-+ while Compiler_Root /= null loop
-+ exit when Prefix.all = Compiler_Root.Root.all;
-+ Compiler_Root := Compiler_Root.Next;
-+ end loop;
-+
-+ if Compiler_Root = null then
-+ First_Compiler_Root :=
-+ new Compiler_Root_Data'
-+ (Root => Prefix,
-+ Runtimes => null,
-+ Next => First_Compiler_Root);
-+ Compiler_Root := First_Compiler_Root;
-+ end if;
-+
-+ -- If there is a runtime for this compiler, check if it is
-+ -- recorded with the compiler root. If it is not, record
-+ -- the runtime.
-+
-+ declare
-+ Runtime : constant String :=
-+ Runtime_Name_For (Lang_Id.Name);
-+ Root : String_Access;
-+
-+ begin
-+ if Runtime'Length > 0 then
-+ if Is_Absolute_Path (Runtime) then
-+ Root := new String'(Runtime);
-+
-+ else
-+ Root :=
-+ new String'
-+ (Prefix.all &
-+ Directory_Separator &
-+ Opt.Target_Value.all &
-+ Directory_Separator &
-+ Runtime);
-+ end if;
-+
-+ Runtime_Root := Compiler_Root.Runtimes;
-+ while Runtime_Root /= null loop
-+ exit when Root.all = Runtime_Root.Root.all;
-+ Runtime_Root := Runtime_Root.Next;
-+ end loop;
-+
-+ if Runtime_Root = null then
-+ Compiler_Root.Runtimes :=
-+ new Runtime_Root_Data'
-+ (Root => Root,
-+ Next => Compiler_Root.Runtimes);
-+ end if;
-+ end if;
-+ end;
-+ end if;
-+ end if;
-+ end if;
-+
-+ Lang_Id := Lang_Id.Next;
-+ end loop;
-+ end Look_For_Project_Paths;
- end Prj.Conf;
-diff --git a/gnat/prj-conf.ads b/gnat/prj-conf.ads
-index df830ad..eae8f52 100644
---- a/gnat/prj-conf.ads
-+++ b/gnat/prj-conf.ads
-@@ -112,20 +112,21 @@ package Prj.Conf is
- procedure Process_Project_And_Apply_Config
- (Main_Project : out Prj.Project_Id;
- User_Project_Node : Prj.Tree.Project_Node_Id;
-- Config_File_Name : String := "";
-+ Config_File_Name : String := "";
- Autoconf_Specified : Boolean;
- Project_Tree : Prj.Project_Tree_Ref;
- Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
- Env : in out Prj.Tree.Environment;
- Packages_To_Check : String_List_Access;
-- Allow_Automatic_Generation : Boolean := True;
-+ Allow_Automatic_Generation : Boolean := True;
- Automatically_Generated : out Boolean;
- Config_File_Path : out String_Access;
-- Target_Name : String := "";
-+ Target_Name : String := "";
- Normalized_Hostname : String;
-- On_Load_Config : Config_File_Hook := null;
-- Reset_Tree : Boolean := True;
-- On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null);
-+ On_Load_Config : Config_File_Hook := null;
-+ Reset_Tree : Boolean := True;
-+ On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null;
-+ Do_Phase_1 : Boolean := True);
- -- Same as above, except the project must already have been parsed through
- -- Prj.Part.Parse, and only the processing of the project and the
- -- configuration is done at this level.
-@@ -138,6 +139,9 @@ package Prj.Conf is
- -- least one source file, or an error is reported via When_No_Sources. If
- -- it is false, this is only required for Ada (and only if it is a language
- -- of the project).
-+ --
-+ -- If Do_Phase_1 is False, then Prj.Proc.Process_Project_Tree_Phase_1
-+ -- should not be called, as it has already been invoked successfully.
-
- Invalid_Config : exception;
-
-@@ -216,13 +220,4 @@ package Prj.Conf is
- function Runtime_Name_Set_For (Language : Name_Id) return Boolean;
- -- Returns True only if Set_Runtime_For has been called for the Language
-
-- procedure Locate_Runtime
-- (Language : Name_Id;
-- Project_Tree : Prj.Project_Tree_Ref;
-- Env : Prj.Tree.Environment);
-- -- If RTS_Name is a base name (a name without path separator), then
-- -- do nothing. Otherwise, convert it to an absolute path (possibly by
-- -- searching it in the project path) and call Set_Runtime_For with the
-- -- absolute path. Fail the program if the path does not exist.
--
- end Prj.Conf;
-diff --git a/gnat/prj-dect.adb b/gnat/prj-dect.adb
-index 028b2bc..461bd87 100644
---- a/gnat/prj-dect.adb
-+++ b/gnat/prj-dect.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2015, 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- --
-@@ -214,10 +214,12 @@ package body Prj.Dect is
- Project_Qualifier_Of (Project, In_Tree);
- Name : constant Name_Id := Name_Of (Current_Package, In_Tree);
- begin
-- if (Qualif = Aggregate and then Name /= Snames.Name_Builder)
-- or else (Qualif = Aggregate_Library
-- and then Name /= Snames.Name_Builder
-- and then Name /= Snames.Name_Install)
-+ if Name /= Snames.Name_Ide
-+ and then
-+ ((Qualif = Aggregate and then Name /= Snames.Name_Builder)
-+ or else
-+ (Qualif = Aggregate_Library and then Name /= Snames.Name_Builder
-+ and then Name /= Snames.Name_Install))
- then
- Error_Msg_Name_1 := Name;
- Error_Msg
-@@ -580,7 +582,7 @@ package body Prj.Dect is
- The_Project := Imported_Or_Extended_Project_Of
- (Current_Project, In_Tree, Token_Name);
-
-- if No (The_Project) then
-+ if No (The_Project) and then not In_Tree.Incomplete_With then
- Error_Msg (Flags, "unknown project", Location);
- Scan (In_Tree); -- past the project name
-
-@@ -615,33 +617,36 @@ package body Prj.Dect is
- Get_Name_String
- (Name_Of (Current_Package, In_Tree)),
- Token_Ptr);
-+ Scan (In_Tree); -- past the package name
-
- else
-- The_Package :=
-- First_Package_Of (The_Project, In_Tree);
--
-- -- Look for the package node
--
-- while Present (The_Package)
-- and then
-- Name_Of (The_Package, In_Tree) /= Token_Name
-- loop
-+ if Present (The_Project) then
- The_Package :=
-- Next_Package_In_Project
-- (The_Package, In_Tree);
-- end loop;
--
-- -- If the package cannot be found in the
-- -- project, issue an error.
--
-- if No (The_Package) then
-- The_Project := Empty_Node;
-- Error_Msg_Name_2 := Project_Name;
-- Error_Msg_Name_1 := Token_Name;
-- Error_Msg
-- (Flags,
-- "package % not declared in project %",
-- Token_Ptr);
-+ First_Package_Of (The_Project, In_Tree);
-+
-+ -- Look for the package node
-+
-+ while Present (The_Package)
-+ and then Name_Of (The_Package, In_Tree) /=
-+ Token_Name
-+ loop
-+ The_Package :=
-+ Next_Package_In_Project
-+ (The_Package, In_Tree);
-+ end loop;
-+
-+ -- If the package cannot be found in the
-+ -- project, issue an error.
-+
-+ if No (The_Package) then
-+ The_Project := Empty_Node;
-+ Error_Msg_Name_2 := Project_Name;
-+ Error_Msg_Name_1 := Token_Name;
-+ Error_Msg
-+ (Flags,
-+ "package % not declared in project %",
-+ Token_Ptr);
-+ end if;
- end if;
-
- Scan (In_Tree); -- past the package name
-@@ -651,7 +656,7 @@ package body Prj.Dect is
- end if;
- end if;
-
-- if Present (The_Project) then
-+ if Present (The_Project) or else In_Tree.Incomplete_With then
-
- -- Looking for '<same attribute name>
-
-@@ -825,11 +830,11 @@ package body Prj.Dect is
- if Present (Case_Variable) then
- String_Type := String_Type_Of (Case_Variable, In_Tree);
-
-- if No (String_Type) then
-+ if Expression_Kind_Of (Case_Variable, In_Tree) /= Single then
- Error_Msg (Flags,
- "variable """ &
- Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
-- """ is not typed",
-+ """ is not a single string",
- Variable_Location);
- end if;
- end if;
-@@ -912,7 +917,8 @@ package body Prj.Dect is
- Parse_Choice_List
- (In_Tree => In_Tree,
- First_Choice => First_Choice,
-- Flags => Flags);
-+ Flags => Flags,
-+ String_Type => Present (String_Type));
- Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
-
- Expect (Tok_Arrow, "`=>`");
-@@ -939,7 +945,8 @@ package body Prj.Dect is
- End_Case_Construction
- (Check_All_Labels => not When_Others and not Quiet_Output,
- Case_Location => Location_Of (Case_Construction, In_Tree),
-- Flags => Flags);
-+ Flags => Flags,
-+ String_Type => Present (String_Type));
-
- Expect (Tok_End, "`END CASE`");
- Remove_Next_End_Node;
-diff --git a/gnat/prj-env.adb b/gnat/prj-env.adb
-index 0bb0eb1..92019fc 100644
---- a/gnat/prj-env.adb
-+++ b/gnat/prj-env.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -24,7 +24,6 @@
- ------------------------------------------------------------------------------
-
- with Fmap;
--with Hostparm;
- with Makeutl; use Makeutl;
- with Opt;
- with Osint; use Osint;
-@@ -131,7 +130,6 @@ package body Prj.Env is
- In_Tree : Project_Tree_Ref;
- Dummy : in out Boolean)
- is
-- pragma Unreferenced (Dummy);
- begin
- Add_To_Path
- (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
-@@ -201,7 +199,7 @@ package body Prj.Env is
- In_Tree : Project_Tree_Ref;
- Dummy : in out Boolean)
- is
-- pragma Unreferenced (Dummy, In_Tree);
-+ pragma Unreferenced (In_Tree);
-
- Path : constant Path_Name_Type :=
- Get_Object_Directory
-@@ -1259,7 +1257,7 @@ package body Prj.Env is
- Tree : Project_Tree_Ref;
- Dummy : in out Integer)
- is
-- pragma Unreferenced (Dummy, Tree);
-+ pragma Unreferenced (Tree);
-
- begin
- -- ??? Set_Ada_Paths has a different behavior for library project
-@@ -1304,8 +1302,6 @@ package body Prj.Env is
- In_Tree : Project_Tree_Ref;
- Dummy : in out Integer)
- is
-- pragma Unreferenced (Dummy);
--
- Current : String_List_Id := Prj.Source_Dirs;
- The_String : String_Element;
-
-@@ -1429,35 +1425,10 @@ package body Prj.Env is
- (Self : Project_Search_Path;
- Name : String) return String_Access
- is
-- function Is_Base_Name (Path : String) return Boolean;
-- -- Returns True if Path has no directory separator
--
-- ------------------
-- -- Is_Base_Name --
-- ------------------
--
-- function Is_Base_Name (Path : String) return Boolean is
-- begin
-- for J in Path'Range loop
-- if Path (J) = Directory_Separator or else Path (J) = '/' then
-- return False;
-- end if;
-- end loop;
--
-- return True;
-- end Is_Base_Name;
--
-- function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
-- (Check_Filename => Is_Directory);
--
-- -- Start of processing for Get_Runtime_Path
--
-+ function Find_Rts_In_Path is
-+ new Prj.Env.Find_Name_In_Path (Check_Filename => Is_Directory);
- begin
-- if not Is_Base_Name (Name) then
-- return Find_Rts_In_Path (Self, Name);
-- else
-- return null;
-- end if;
-+ return Find_Rts_In_Path (Self, Name);
- end Get_Runtime_Path;
-
- ----------------
-@@ -1676,7 +1647,7 @@ package body Prj.Env is
- In_Tree : Project_Tree_Ref;
- Dummy : in out Boolean)
- is
-- pragma Unreferenced (Dummy, In_Tree);
-+ pragma Unreferenced (In_Tree);
-
- Path : Path_Name_Type;
-
-@@ -1902,14 +1873,13 @@ package body Prj.Env is
- -------------------------------------
-
- procedure Initialize_Default_Project_Path
-- (Self : in out Project_Search_Path;
-- Target_Name : String)
-+ (Self : in out Project_Search_Path;
-+ Target_Name : String;
-+ Runtime_Name : String := "")
- is
-- Add_Default_Dir : Boolean := True;
-+ Add_Default_Dir : Boolean := Target_Name /= "-";
- First : Positive;
- Last : Positive;
-- New_Len : Positive;
-- New_Last : Positive;
-
- Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
- Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
-@@ -1925,6 +1895,30 @@ package body Prj.Env is
- -- The path name(s) of directories where project files may reside.
- -- May be empty.
-
-+ Prefix : String_Ptr;
-+ Runtime : String_Ptr;
-+
-+ procedure Add_Target;
-+ -- Add :<prefix>/<target> to the project path
-+
-+ ----------------
-+ -- Add_Target --
-+ ----------------
-+
-+ procedure Add_Target is
-+ begin
-+ Add_Str_To_Name_Buffer
-+ (Path_Separator & Prefix.all & Target_Name);
-+
-+ -- Note: Target_Name has a trailing / when it comes from Sdefault
-+
-+ if Name_Buffer (Name_Len) /= '/' then
-+ Add_Char_To_Name_Buffer (Directory_Separator);
-+ end if;
-+ end Add_Target;
-+
-+ -- Start of processing for Initialize_Default_Project_Path
-+
- begin
- if Is_Initialized (Self) then
- return;
-@@ -2047,17 +2041,14 @@ package body Prj.Env is
-
- Last := Last - 1;
-
-- elsif not Hostparm.OpenVMS
-- or else not Is_Absolute_Path (Name_Buffer (First .. Last))
-- then
-- -- On VMS, only expand relative path names, as absolute paths
-- -- may correspond to multi-valued VMS logical names.
--
-+ else
- declare
- New_Dir : constant String :=
- Normalize_Pathname
- (Name_Buffer (First .. Last),
- Resolve_Links => Opt.Follow_Links_For_Dirs);
-+ New_Len : Positive;
-+ New_Last : Positive;
-
- begin
- -- If the absolute path was resolved and is different from
-@@ -2085,73 +2076,81 @@ package body Prj.Env is
- -- Set the initial value of Current_Project_Path
-
- if Add_Default_Dir then
-- declare
-- Prefix : String_Ptr;
--
-- begin
-- if Sdefault.Search_Dir_Prefix = null then
--
-- -- gprbuild case
--
-- Prefix := new String'(Executable_Prefix_Path);
--
-- else
-- Prefix := new String'(Sdefault.Search_Dir_Prefix.all
-- & ".." & Dir_Separator
-- & ".." & Dir_Separator
-- & ".." & Dir_Separator
-- & ".." & Dir_Separator);
-- end if;
--
-- if Prefix.all /= "" then
-- if Target_Name /= "" then
--
-- -- $prefix/$target/lib/gnat
-+ if Sdefault.Search_Dir_Prefix = null then
-
-- Add_Str_To_Name_Buffer
-- (Path_Separator & Prefix.all & Target_Name);
-+ -- gprbuild case
-
-- -- Note: Target_Name has a trailing / when it comes from
-- -- Sdefault.
-+ Prefix := new String'(Executable_Prefix_Path);
-
-- if Name_Buffer (Name_Len) /= '/' then
-- Add_Char_To_Name_Buffer (Directory_Separator);
-- end if;
-+ else
-+ Prefix := new String'(Sdefault.Search_Dir_Prefix.all
-+ & ".." & Dir_Separator
-+ & ".." & Dir_Separator
-+ & ".." & Dir_Separator
-+ & ".." & Dir_Separator);
-+ end if;
-
-- Add_Str_To_Name_Buffer
-- ("lib" & Directory_Separator & "gnat");
-+ if Prefix.all /= "" then
-+ if Target_Name /= "" then
-
-- -- $prefix/$target/share/gpr
-+ if Runtime_Name /= "" then
-+ if Base_Name (Runtime_Name) = Runtime_Name then
-
-- Add_Str_To_Name_Buffer
-- (Path_Separator & Prefix.all & Target_Name);
-+ -- $prefix/$target/$runtime/lib/gnat
-+ Add_Target;
-+ Add_Str_To_Name_Buffer
-+ (Runtime_Name & Directory_Separator &
-+ "lib" & Directory_Separator & "gnat");
-
-- -- Note: Target_Name has a trailing / when it comes from
-- -- Sdefault.
-+ -- $prefix/$target/$runtime/share/gpr
-+ Add_Target;
-+ Add_Str_To_Name_Buffer
-+ (Runtime_Name & Directory_Separator &
-+ "share" & Directory_Separator & "gpr");
-
-- if Name_Buffer (Name_Len) /= '/' then
-- Add_Char_To_Name_Buffer (Directory_Separator);
-+ else
-+ Runtime :=
-+ new String'(Normalize_Pathname (Runtime_Name));
-+
-+ -- $runtime_dir/lib/gnat
-+ Add_Str_To_Name_Buffer
-+ (Path_Separator & Runtime.all & Directory_Separator &
-+ "lib" & Directory_Separator & "gnat");
-+
-+ -- $runtime_dir/share/gpr
-+ Add_Str_To_Name_Buffer
-+ (Path_Separator & Runtime.all & Directory_Separator &
-+ "share" & Directory_Separator & "gpr");
- end if;
--
-- Add_Str_To_Name_Buffer
-- ("share" & Directory_Separator & "gpr");
- end if;
-
-- -- $prefix/share/gpr
-+ -- $prefix/$target/lib/gnat
-
-+ Add_Target;
- Add_Str_To_Name_Buffer
-- (Path_Separator & Prefix.all &
-- "share" & Directory_Separator & "gpr");
-+ ("lib" & Directory_Separator & "gnat");
-
-- -- $prefix/lib/gnat
-+ -- $prefix/$target/share/gpr
-
-+ Add_Target;
- Add_Str_To_Name_Buffer
-- (Path_Separator & Prefix.all &
-- "lib" & Directory_Separator & "gnat");
-+ ("share" & Directory_Separator & "gpr");
- end if;
-
-- Free (Prefix);
-- end;
-+ -- $prefix/share/gpr
-+
-+ Add_Str_To_Name_Buffer
-+ (Path_Separator & Prefix.all & "share"
-+ & Directory_Separator & "gpr");
-+
-+ -- $prefix/lib/gnat
-+
-+ Add_Str_To_Name_Buffer
-+ (Path_Separator & Prefix.all & "lib"
-+ & Directory_Separator & "gnat");
-+ end if;
-+
-+ Free (Prefix);
- end if;
-
- Self.Path := new String'(Name_Buffer (1 .. Name_Len));
-@@ -2302,8 +2301,7 @@ package body Prj.Env is
- exit Check_Dot;
- end if;
-
-- exit Check_Dot when File (K) = Directory_Separator
-- or else File (K) = '/';
-+ exit Check_Dot when Is_Directory_Separator (File (K));
- end loop Check_Dot;
-
- if not Is_Absolute_Path (File) then
-diff --git a/gnat/prj-env.ads b/gnat/prj-env.ads
-index 21239b4..a7617af 100644
---- a/gnat/prj-env.ads
-+++ b/gnat/prj-env.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -171,12 +171,16 @@ package Prj.Env is
- No_Project_Search_Path : constant Project_Search_Path;
-
- procedure Initialize_Default_Project_Path
-- (Self : in out Project_Search_Path;
-- Target_Name : String);
-- -- Initialize Self. It will then contain the default project path on the
-- -- given target (including directories specified by the environment
-- -- variables ADA_PROJECT_PATH and GPR_PROJECT_PATH). This does nothing if
-- -- Self has already been initialized.
-+ (Self : in out Project_Search_Path;
-+ Target_Name : String;
-+ Runtime_Name : String := "");
-+ -- Initialize Self. It will then contain the default project path on
-+ -- the given target and runtime (including directories specified by the
-+ -- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
-+ -- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-", then
-+ -- the path contains only those directories specified by the environment
-+ -- variables (except "-"). This does nothing if Self has already been
-+ -- initialized.
-
- procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
- -- Copy From into To
-@@ -243,10 +247,8 @@ package Prj.Env is
- function Get_Runtime_Path
- (Self : Project_Search_Path;
- Name : String) return String_Access;
-- -- Compute the full path for the project-based runtime name. It first
-- -- checks that name is not a simple name (must has a path separator in it),
-- -- and returns null in case of failure. This check might be removed in the
-- -- future. The name is simply searched on the project path.
-+ -- Compute the full path for the project-based runtime name.
-+ -- Name is simply searched on the project path.
-
- private
- package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable
-diff --git a/gnat/prj-err.adb b/gnat/prj-err.adb
-index 75cf23b..44ad905 100644
---- a/gnat/prj-err.adb
-+++ b/gnat/prj-err.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2002-2011, Free Software Foundation, Inc. --
-+-- Copyright (C) 2002-2014, 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- --
-@@ -72,6 +72,12 @@ package body Prj.Err is
- Real_Location : Source_Ptr := Location;
-
- begin
-+ -- Don't post message if incompleted with's (avoid junk cascaded errors)
-+
-+ if Flags.Incomplete_Withs then
-+ return;
-+ end if;
-+
- -- Display the error message in the traces so that it appears in the
- -- correct location in the traces (otherwise error messages are only
- -- displayed at the end and it is difficult to see when they were
-diff --git a/gnat/prj-nmsc.adb b/gnat/prj-nmsc.adb
-index e6a1f4c..7b3d337 100644
---- a/gnat/prj-nmsc.adb
-+++ b/gnat/prj-nmsc.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2000-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2000-2015, 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- --
-@@ -34,7 +34,6 @@ with Prj.Tree; use Prj.Tree;
- with Prj.Util; use Prj.Util;
- with Sinput.P;
- with Snames; use Snames;
--with Targparm; use Targparm;
-
- with Ada; use Ada;
- with Ada.Characters.Handling; use Ada.Characters.Handling;
-@@ -547,12 +546,9 @@ package body Prj.Nmsc is
- while J <= Str'Last loop
- Name_Len := Name_Len + 1;
-
-- if J <= Max
-- and then Str (J .. J + Pattern'Length - 1) = Pattern
-- then
-+ if J <= Max and then Str (J .. J + Pattern'Length - 1) = Pattern then
- Name_Buffer (Name_Len) := Replacement;
- J := J + Pattern'Length;
--
- else
- Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
- J := J + 1;
-@@ -738,8 +734,7 @@ package body Prj.Nmsc is
- -- the same file name in unrelated projects.
-
- elsif Is_Extending (Project, Source.Project) then
-- if not Locally_Removed
-- and then Naming_Exception /= Inherited
-+ if not Locally_Removed and then Naming_Exception /= Inherited
- then
- Source_To_Replace := Source;
- end if;
-@@ -1808,7 +1803,10 @@ package body Prj.Nmsc is
- Lang_Index := Get_Language_From_Name
- (Project, Get_Name_String (Element.Index));
-
-- if Lang_Index /= No_Language_Index then
-+ if Lang_Index /= No_Language_Index
-+ and then Element.Value.Kind = Single
-+ and then Element.Value.Value /= No_Name
-+ then
- case Current_Array.Name is
- when Name_Spec_Suffix | Name_Specification_Suffix =>
-
-@@ -2403,7 +2401,8 @@ package body Prj.Nmsc is
- Lang_Index.Config.Toolchain_Version :=
- Element.Value.Value;
-
-- -- For Ada, set proper checksum computation mode
-+ -- For Ada, set proper checksum computation mode,
-+ -- which has changed from version to version.
-
- if Lang_Index.Name = Name_Ada then
- declare
-@@ -2432,7 +2431,7 @@ package body Prj.Nmsc is
- then
- Checksum_GNAT_5_03 := True;
-
-- -- Version 5.02 or earlier
-+ -- Version 5.02 or earlier (no checksums)
-
- if Vers (6) /= '5'
- or else Vers (Vers'Last) < '3'
-@@ -2576,11 +2575,12 @@ package body Prj.Nmsc is
-
- if Data.Flags.Compiler_Driver_Mandatory
- and then Lang_Index.Config.Compiler_Driver = No_File
-+ and then not Project.Externally_Built
- then
- Error_Msg_Name_1 := Lang_Index.Display_Name;
- Error_Msg
- (Data.Flags,
-- "?no compiler specified for language %%" &
-+ "?\no compiler specified for language %%" &
- ", ignoring all its sources",
- No_Location, Project);
-
-@@ -2607,7 +2607,7 @@ package body Prj.Nmsc is
- if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
- Error_Msg
- (Data.Flags,
-- "Spec_Suffix not specified for " &
-+ "\Spec_Suffix not specified for " &
- Get_Name_String (Lang_Index.Name),
- No_Location, Project);
- end if;
-@@ -2615,7 +2615,7 @@ package body Prj.Nmsc is
- if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
- Error_Msg
- (Data.Flags,
-- "Body_Suffix not specified for " &
-+ "\Body_Suffix not specified for " &
- Get_Name_String (Lang_Index.Name),
- No_Location, Project);
- end if;
-@@ -2633,7 +2633,7 @@ package body Prj.Nmsc is
- Error_Msg_Name_1 := Lang_Index.Display_Name;
- Error_Msg
- (Data.Flags,
-- "no suffixes specified for %%",
-+ "\no suffixes specified for %%",
- No_Location, Project);
- end if;
- end if;
-@@ -3031,6 +3031,87 @@ package body Prj.Nmsc is
- procedure Check_Library (Proj : Project_Id; Extends : Boolean);
- -- Check if an imported or extended project if also a library project
-
-+ procedure Check_Aggregate_Library_Dirs;
-+ -- Check that the library directory and the library ALI directory of an
-+ -- aggregate library project are not the same as the object directory or
-+ -- the library directory of any of its aggregated projects.
-+
-+ ----------------------------------
-+ -- Check_Aggregate_Library_Dirs --
-+ ----------------------------------
-+
-+ procedure Check_Aggregate_Library_Dirs is
-+ procedure Process_Aggregate (Proj : Project_Id);
-+ -- Recursive procedure to check the aggregated projects, as they may
-+ -- also be aggregated library projects.
-+
-+ -----------------------
-+ -- Process_Aggregate --
-+ -----------------------
-+
-+ procedure Process_Aggregate (Proj : Project_Id) is
-+ Agg : Aggregated_Project_List;
-+
-+ begin
-+ Agg := Proj.Aggregated_Projects;
-+ while Agg /= null loop
-+ Error_Msg_Name_1 := Agg.Project.Name;
-+
-+ if Agg.Project.Qualifier /= Aggregate_Library
-+ and then Project.Library_ALI_Dir.Name =
-+ Agg.Project.Object_Directory.Name
-+ then
-+ Error_Msg
-+ (Data.Flags,
-+ "aggregate library 'A'L'I directory cannot be shared with"
-+ & " object directory of aggregated project %%",
-+ The_Lib_Kind.Location, Project);
-+
-+ elsif Project.Library_ALI_Dir.Name =
-+ Agg.Project.Library_Dir.Name
-+ then
-+ Error_Msg
-+ (Data.Flags,
-+ "aggregate library 'A'L'I directory cannot be shared with"
-+ & " library directory of aggregated project %%",
-+ The_Lib_Kind.Location, Project);
-+
-+ elsif Agg.Project.Qualifier /= Aggregate_Library
-+ and then Project.Library_Dir.Name =
-+ Agg.Project.Object_Directory.Name
-+ then
-+ Error_Msg
-+ (Data.Flags,
-+ "aggregate library directory cannot be shared with"
-+ & " object directory of aggregated project %%",
-+ The_Lib_Kind.Location, Project);
-+
-+ elsif Project.Library_Dir.Name =
-+ Agg.Project.Library_Dir.Name
-+ then
-+ Error_Msg
-+ (Data.Flags,
-+ "aggregate library directory cannot be shared with"
-+ & " library directory of aggregated project %%",
-+ The_Lib_Kind.Location, Project);
-+ end if;
-+
-+ if Agg.Project.Qualifier = Aggregate_Library then
-+ Process_Aggregate (Agg.Project);
-+ end if;
-+
-+ Agg := Agg.Next;
-+ end loop;
-+ end Process_Aggregate;
-+
-+ -- Start of processing for Check_Aggregate_Library_Dirs
-+
-+ begin
-+ if Project.Qualifier = Aggregate_Library then
-+ Process_Aggregate (Project);
-+ end if;
-+ end Check_Aggregate_Library_Dirs;
-+
- -------------------
- -- Check_Library --
- -------------------
-@@ -3243,9 +3324,6 @@ package body Prj.Nmsc is
- (Data.Flags,
- "library directory { does not exist",
- Lib_Dir.Location, Project);
--
-- else
-- Project.Library_Dir := No_Path_Information;
- end if;
-
- -- Checks for object/source directories
-@@ -3358,7 +3436,7 @@ package body Prj.Nmsc is
-
- Project.Library :=
- Project.Library_Dir /= No_Path_Information
-- and then Project.Library_Name /= No_Name;
-+ and then Project.Library_Name /= No_Name;
-
- if Project.Extends = No_Project then
- case Project.Qualifier is
-@@ -3695,7 +3773,7 @@ package body Prj.Nmsc is
- if Switches /= No_Array_Element then
- Error_Msg
- (Data.Flags,
-- "?Linker switches not taken into account in library " &
-+ "?\Linker switches not taken into account in library " &
- "projects",
- No_Location, Project);
- end if;
-@@ -3751,6 +3829,13 @@ package body Prj.Nmsc is
- Continuation := Continuation_String'Access;
- end if;
-
-+ -- Check that aggregated libraries do not share the aggregate
-+ -- Library_ALI_Dir.
-+
-+ if Project.Qualifier = Aggregate_Library then
-+ Check_Aggregate_Library_Dirs;
-+ end if;
-+
- if Project.Library and not Data.In_Aggregate_Lib then
-
- -- Record the library name
-@@ -4205,7 +4290,9 @@ package body Prj.Nmsc is
- Shared => Shared);
- end if;
-
-- if Suffix /= Nil_Variable_Value then
-+ if Suffix /= Nil_Variable_Value
-+ and then Suffix.Value /= No_Name
-+ then
- Lang_Id.Config.Naming_Data.Spec_Suffix :=
- File_Name_Type (Suffix.Value);
-
-@@ -4238,7 +4325,9 @@ package body Prj.Nmsc is
- Shared => Shared);
- end if;
-
-- if Suffix /= Nil_Variable_Value then
-+ if Suffix /= Nil_Variable_Value
-+ and then Suffix.Value /= No_Name
-+ then
- Lang_Id.Config.Naming_Data.Body_Suffix :=
- File_Name_Type (Suffix.Value);
-
-@@ -4630,7 +4719,7 @@ package body Prj.Nmsc is
- then
- Error_Msg
- (Data.Flags,
-- "Library_Standalone valid only if Library_Interface is set",
-+ "Library_Standalone valid only if library has Ada interfaces",
- Lib_Standalone.Location, Project);
- end if;
-
-@@ -4950,9 +5039,7 @@ package body Prj.Nmsc is
-
- if OK then
- for J in 1 .. Name_Len loop
-- if Name_Buffer (J) = '/'
-- or else Name_Buffer (J) = Directory_Separator
-- then
-+ if Is_Directory_Separator (Name_Buffer (J)) then
- OK := False;
- exit;
- end if;
-@@ -5019,7 +5106,7 @@ package body Prj.Nmsc is
-
- Error_Msg_Warn :=
- Project.Symbol_Data.Symbol_Policy /= Controlled
-- and then Project.Symbol_Data.Symbol_Policy /= Direct;
-+ and then Project.Symbol_Data.Symbol_Policy /= Direct;
-
- Error_Msg
- (Data.Flags,
-@@ -5140,22 +5227,6 @@ package body Prj.Nmsc is
- Name_Len := The_Name'Length;
- Name_Buffer (1 .. Name_Len) := The_Name;
-
-- -- Special cases of children of packages A, G, I and S on VMS
--
-- if OpenVMS_On_Target
-- and then Name_Len > 3
-- and then Name_Buffer (2 .. 3) = "__"
-- and then
-- (Name_Buffer (1) = 'a' or else
-- Name_Buffer (1) = 'g' or else
-- Name_Buffer (1) = 'i' or else
-- Name_Buffer (1) = 's')
-- then
-- Name_Buffer (2) := '.';
-- Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
-- Name_Len := Name_Len - 1;
-- end if;
--
- Real_Name := Name_Find;
-
- if Is_Reserved (Real_Name) then
-@@ -5270,9 +5341,7 @@ package body Prj.Nmsc is
- function Compute_Directory_Last (Dir : String) return Natural is
- begin
- if Dir'Length > 1
-- and then (Dir (Dir'Last - 1) = Directory_Separator
-- or else
-- Dir (Dir'Last - 1) = '/')
-+ and then Is_Directory_Separator (Dir (Dir'Last - 1))
- then
- return Dir'Last - 1;
- else
-@@ -5433,15 +5502,16 @@ package body Prj.Nmsc is
- Dir_Exists : Boolean;
-
- No_Sources : constant Boolean :=
-- ((not Source_Files.Default
-- and then Source_Files.Values = Nil_String)
-- or else
-- (not Source_Dirs.Default
-- and then Source_Dirs.Values = Nil_String)
-- or else
-- (not Languages.Default
-- and then Languages.Values = Nil_String))
-- and then Project.Extends = No_Project;
-+ Project.Qualifier = Abstract_Project
-+ or else (((not Source_Files.Default
-+ and then Source_Files.Values = Nil_String)
-+ or else
-+ (not Source_Dirs.Default
-+ and then Source_Dirs.Values = Nil_String)
-+ or else
-+ (not Languages.Default
-+ and then Languages.Values = Nil_String))
-+ and then Project.Extends = No_Project);
-
- -- Start of processing for Get_Directories
-
-@@ -5505,6 +5575,7 @@ package body Prj.Nmsc is
-
- if not Dir_Exists and then not Project.Externally_Built then
- if Opt.Directories_Must_Exist_In_Projects then
-+
- -- The object directory does not exist, report an error if
- -- the project is not externally built.
-
-@@ -5514,9 +5585,6 @@ package body Prj.Nmsc is
- (Data.Flags, Data.Flags.Require_Obj_Dirs,
- "object directory { not found",
- Project.Location, Project);
--
-- else
-- Project.Object_Directory := No_Path_Information;
- end if;
- end if;
- end if;
-@@ -5619,8 +5687,7 @@ package body Prj.Nmsc is
-
- pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
-
-- if not Source_Files.Default
-- and then Source_Files.Values = Nil_String
-+ if not Source_Files.Default and then Source_Files.Values = Nil_String
- then
- Project.Source_Dirs := Nil_String;
-
-@@ -5785,9 +5852,7 @@ package body Prj.Nmsc is
-
- -- A non empty, non comment line should contain a file name
-
-- if Last /= 0
-- and then (Last = 1 or else Line (1 .. 2) /= "--")
-- then
-+ if Last /= 0 and then (Last = 1 or else Line (1 .. 2) /= "--") then
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
-@@ -5796,7 +5861,7 @@ package body Prj.Nmsc is
- -- Check that there is no directory information
-
- for J in 1 .. Last loop
-- if Line (J) = '/' or else Line (J) = Directory_Separator then
-+ if Is_Directory_Separator (Line (J)) then
- Error_Msg_File_1 := Source_Name;
- Error_Msg
- (Data.Flags,
-@@ -5970,20 +6035,15 @@ package body Prj.Nmsc is
- -- In the standard GNAT naming scheme, check for special cases: children
- -- or separates of A, G, I or S, and run time sources.
-
-- if Is_Standard_GNAT_Naming (Naming)
-- and then Name_Len >= 3
-- then
-+ if Is_Standard_GNAT_Naming (Naming) and then Name_Len >= 3 then
- declare
- S1 : constant Character := Name_Buffer (1);
- S2 : constant Character := Name_Buffer (2);
- S3 : constant Character := Name_Buffer (3);
-
- begin
-- if S1 = 'a'
-- or else S1 = 'g'
-- or else S1 = 'i'
-- or else S1 = 's'
-- then
-+ if S1 = 'a' or else S1 = 'g' or else S1 = 'i' or else S1 = 's' then
-+
- -- Children or separates of packages A, G, I or S. These names
- -- are x__ ... or x~... (where x is a, g, i, or s). Both
- -- versions (x__... and x~...) are allowed in all platforms,
-@@ -6051,9 +6111,7 @@ package body Prj.Nmsc is
- end if;
- end if;
-
-- if Unit /= No_Name
-- and then Current_Verbosity = High
-- then
-+ if Unit /= No_Name and then Current_Verbosity = High then
- case Kind is
- when Spec => Debug_Output ("spec of", Unit);
- when Impl => Debug_Output ("body of", Unit);
-@@ -6232,11 +6290,19 @@ package body Prj.Nmsc is
-
- exception
- when Use_Error =>
-+
-+ -- Output message with name of directory. Note that we
-+ -- use the ~ insertion method here in case the name
-+ -- has special characters in it.
-+
-+ Error_Msg_Strlen := Full_Path_Name'Length;
-+ Error_Msg_String (1 .. Error_Msg_Strlen) :=
-+ Full_Path_Name.all;
- Error_Msg
- (Data.Flags,
-- "could not create " & Create &
-- " directory " & Full_Path_Name.all,
-- Location, Project);
-+ "could not create " & Create & " directory ~",
-+ Location,
-+ Project);
- end;
- end if;
- end if;
-@@ -6244,7 +6310,7 @@ package body Prj.Nmsc is
-
- Dir_Exists := Is_Directory (Full_Path_Name.all);
-
-- if not Must_Exist or else Dir_Exists then
-+ if not Must_Exist or Dir_Exists then
- declare
- Normed : constant String :=
- Normalize_Pathname
-@@ -6422,14 +6488,12 @@ package body Prj.Nmsc is
- -- Check that there is no directory information
-
- for J in 1 .. Last loop
-- if Line (J) = '/'
-- or else Line (J) = Directory_Separator
-- then
-+ if Is_Directory_Separator (Line (J)) then
- Error_Msg_File_1 := Name;
- Error_Msg
- (Data.Flags,
-- "file name cannot include " &
-- "directory information ({)",
-+ "file name cannot include "
-+ & "directory information ({)",
- Location, Project.Project);
- exit;
- end if;
-@@ -6513,8 +6577,7 @@ package body Prj.Nmsc is
- if Project.Project.Extends = No_Project
- and then
- Project.Project.Object_Directory = Project.Project.Directory
-- and then
-- not (Project.Project.Qualifier = Aggregate_Library)
-+ and then not (Project.Project.Qualifier = Aggregate_Library)
- then
- Project.Project.Object_Directory := No_Path_Information;
- end if;
-@@ -6537,9 +6600,7 @@ package body Prj.Nmsc is
- -- Check that there is no directory information
-
- for J in 1 .. Name_Len loop
-- if Name_Buffer (J) = '/'
-- or else Name_Buffer (J) = Directory_Separator
-- then
-+ if Is_Directory_Separator (Name_Buffer (J)) then
- Error_Msg_File_1 := Name;
- Error_Msg
- (Data.Flags,
-@@ -6644,7 +6705,9 @@ package body Prj.Nmsc is
- (Project.Source_Names, Source.File);
-
- if NL /= No_Name_Location and then not NL.Listed then
-+
- -- Remove the exception
-+
- Source_Names_Htable.Set
- (Project.Source_Names,
- Source.File,
-@@ -6737,7 +6800,7 @@ package body Prj.Nmsc is
- Error_Msg_Name_2 := Source.Unit.Name;
- Error_Or_Warning
- (Data.Flags, Data.Flags.Missing_Source_Files,
-- "source file %% for unit %% not found",
-+ "\source file %% for unit %% not found",
- No_Location, Project.Project);
- end if;
- end if;
-@@ -6989,9 +7052,7 @@ package body Prj.Nmsc is
-
- Source.Kind := Kind;
-
-- if Current_Verbosity = High
-- and then Source.File /= No_File
-- then
-+ if Current_Verbosity = High and then Source.File /= No_File then
- Debug_Output ("override kind for "
- & Get_Name_String (Source.File)
- & " idx=" & Source.Index'Img
-@@ -7160,8 +7221,7 @@ package body Prj.Nmsc is
-
- -- A file name in a list must be a source of a language
-
-- if Data.Flags.Error_On_Unknown_Language
-- and then Name_Loc.Found
-+ if Data.Flags.Error_On_Unknown_Language and then Name_Loc.Found
- then
- Error_Msg_File_1 := File_Name;
- Error_Msg
-@@ -7328,19 +7388,17 @@ package body Prj.Nmsc is
- Read (Dir, Name, Last);
- exit when Last = 0;
-
-- if Name (1 .. Last) /= "."
-- and then
-- Name (1 .. Last) /= ".."
-- then
-+ if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then
- declare
- Path_Name : constant String :=
-- Normalize_Pathname
-- (Name => Name (1 .. Last),
-- Directory => Path_Str,
-- Resolve_Links => Resolve_Links)
-- & Directory_Separator;
-- Path2 : Path_Information;
-- OK : Boolean := True;
-+ Normalize_Pathname
-+ (Name => Name (1 .. Last),
-+ Directory => Path_Str,
-+ Resolve_Links => Resolve_Links)
-+ & Directory_Separator;
-+
-+ Path2 : Path_Information;
-+ OK : Boolean := True;
-
- begin
- if Is_Directory (Path_Name) then
-@@ -7414,8 +7472,7 @@ package body Prj.Nmsc is
-
- if Search_For = Search_Files then
- while Pattern_End >= Pattern'First
-- and then Pattern (Pattern_End) /= '/'
-- and then Pattern (Pattern_End) /= Directory_Separator
-+ and then not Is_Directory_Separator (Pattern (Pattern_End))
- loop
- Pattern_End := Pattern_End - 1;
- end loop;
-@@ -7451,9 +7508,9 @@ package body Prj.Nmsc is
- Recursive :=
- Pattern_End - 1 >= Pattern'First
- and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
-- and then (Pattern_End - 1 = Pattern'First
-- or else Pattern (Pattern_End - 2) = '/'
-- or else Pattern (Pattern_End - 2) = Directory_Separator);
-+ and then
-+ (Pattern_End - 1 = Pattern'First
-+ or else Is_Directory_Separator (Pattern (Pattern_End - 2)));
-
- if Recursive then
- Pattern_End := Pattern_End - 2;
-@@ -7570,7 +7627,7 @@ package body Prj.Nmsc is
- declare
- Source_Directory : constant String :=
- Get_Name_String (Element.Value)
-- & Directory_Separator;
-+ & Directory_Separator;
-
- Dir_Last : constant Natural :=
- Compute_Directory_Last (Source_Directory);
-@@ -7739,7 +7796,7 @@ package body Prj.Nmsc is
- Error_Msg_File_1 := Source.File;
- Error_Msg
- (Data.Flags,
-- "{ cannot be both excluded and an exception file name",
-+ "\{ cannot be both excluded and an exception file name",
- No_Location, Project.Project);
- end if;
-
-@@ -7826,9 +7883,7 @@ package body Prj.Nmsc is
- Continuation : Boolean := False;
- Iter : Source_Iterator;
- begin
-- if not Project.Project.Externally_Built
-- and then not Extending
-- then
-+ if not Project.Project.Externally_Built and then not Extending then
- Language := Project.Project.Languages;
- while Language /= No_Language_Index loop
-
-@@ -7888,13 +7943,15 @@ package body Prj.Nmsc is
- if Source /= No_Source
- and then Source.Replaced_By = No_Source
- and then Source.Path /= Src.Path
-+ and then Source.Index = 0
-+ and then Src.Index = 0
- and then Is_Extending (Src.Project, Source.Project)
- then
- Error_Msg_File_1 := Src.File;
- Error_Msg_File_2 := Source.File;
- Error_Msg
- (Data.Flags,
-- "{ and { have the same object file name",
-+ "\{ and { have the same object file name",
- No_Location, Project.Project);
-
- else
-@@ -8143,11 +8200,9 @@ package body Prj.Nmsc is
- -- unit name is not null.
-
- if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
--
- declare
- UData : Unit_Index :=
-- Units_Htable.Get
-- (Data.Tree.Units_HT, Src.Unit_Name);
-+ Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
- begin
- if UData = No_Unit_Index then
- UData := new Unit_Data;
-@@ -8466,7 +8521,7 @@ package body Prj.Nmsc is
- Show_Source_Dirs (Project, Shared);
- end if;
-
-- if Project.Qualifier = Dry then
-+ if Project.Qualifier = Abstract_Project then
- Check_Abstract_Project (Project, Data);
- end if;
- end case;
-diff --git a/gnat/prj-part.adb b/gnat/prj-part.adb
-index 48b57aa..c4cf2da 100644
---- a/gnat/prj-part.adb
-+++ b/gnat/prj-part.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -349,8 +349,7 @@ package body Prj.Part is
- Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
-
- while Name_Len > 0
-- and then Name_Buffer (Name_Len) /= Directory_Separator
-- and then Name_Buffer (Name_Len) /= '/'
-+ and then not Is_Directory_Separator (Name_Buffer (Name_Len))
- loop
- Name_Len := Name_Len - 1;
- end loop;
-@@ -554,6 +553,8 @@ package body Prj.Part is
-
- begin
- In_Tree.Incomplete_With := False;
-+ Project_Stack.Init;
-+ Tree_Private_Part.Projects_Htable.Reset (In_Tree.Projects_HT);
-
- if not Is_Initialized (Env.Project_Path) then
- Prj.Env.Initialize_Default_Project_Path
-@@ -894,6 +895,7 @@ package body Prj.Part is
- if Imported_Path_Name_Id = No_Path then
- if Env.Flags.Ignore_Missing_With then
- In_Tree.Incomplete_With := True;
-+ Env.Flags.Incomplete_Withs := True;
-
- else
- -- The project file cannot be found
-@@ -1094,7 +1096,8 @@ package body Prj.Part is
- while Present (With_Clause) loop
- Imported := Project_Node_Of (With_Clause, In_Tree);
-
-- if Project_Qualifier_Of (Imported, In_Tree) /= Dry then
-+ if Project_Qualifier_Of (Imported, In_Tree) /= Abstract_Project
-+ then
- Error_Msg_Name_1 := Name_Id (Path_Name_Of (Imported, In_Tree));
- Error_Msg (Flags, "can only import abstract projects, not %%",
- Token_Ptr);
-@@ -1152,7 +1155,7 @@ package body Prj.Part is
- Qualifier_Location := Token_Ptr;
-
- if Token = Tok_Abstract then
-- Proj_Qualifier := Dry;
-+ Proj_Qualifier := Abstract_Project;
- Scan (In_Tree);
-
- elsif Token = Tok_Identifier then
-@@ -1296,7 +1299,6 @@ package body Prj.Part is
- Name_From_Path : constant Name_Id :=
- Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
- Name_Of_Project : Name_Id := No_Name;
-- Display_Name_Of_Project : Name_Id := No_Name;
-
- Duplicated : Boolean := False;
-
-@@ -1370,7 +1372,8 @@ package body Prj.Part is
- if Extended then
-
- if A_Project_Name_And_Node.Extended then
-- if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
-+ if A_Project_Name_And_Node.Proj_Qualifier /= Abstract_Project
-+ then
- Error_Msg
- (Env.Flags,
- "cannot extend the same project file several times",
-@@ -1631,11 +1634,11 @@ package body Prj.Part is
- end if;
- end;
-
-- -- Read the original casing of the project name
-+ -- Read the original casing of the project name and put it in the
-+ -- project node.
-
- declare
- Loc : Source_Ptr;
--
- begin
- Loc := Location_Of (Project, In_Tree);
- for J in 1 .. Name_Len loop
-@@ -1643,7 +1646,7 @@ package body Prj.Part is
- Loc := Loc + 1;
- end loop;
-
-- Display_Name_Of_Project := Name_Find;
-+ Set_Display_Name_Of (Project, In_Tree, Name_Find);
- end;
-
- declare
-@@ -1811,8 +1814,11 @@ package body Prj.Part is
- -- with sources if it inherits sources from the project
- -- it extends.
-
-- if Project_Qualifier_Of (Project, In_Tree) = Dry and then
-- Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
-+ if Project_Qualifier_Of (Project, In_Tree) =
-+ Abstract_Project
-+ and then
-+ Project_Qualifier_Of (Extended_Project, In_Tree) /=
-+ Abstract_Project
- then
- Error_Msg
- (Env.Flags, "an abstract project can only extend " &
-@@ -1925,7 +1931,8 @@ package body Prj.Part is
- Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
-
- if Present (Extended_Project)
-- and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
-+ and then Project_Qualifier_Of (Extended_Project, In_Tree) /=
-+ Abstract_Project
- then
- Set_Extending_Project_Of
- (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
-@@ -2011,7 +2018,6 @@ package body Prj.Part is
- (T => In_Tree.Projects_HT,
- K => Name_Of_Project,
- E => (Name => Name_Of_Project,
-- Display_Name => Display_Name_Of_Project,
- Node => Project,
- Resolved_Path => Resolved_Path_Name,
- Extended => Extended,
-diff --git a/gnat/prj-pp.adb b/gnat/prj-pp.adb
-index 30402ea..9ccd935 100644
---- a/gnat/prj-pp.adb
-+++ b/gnat/prj-pp.adb
-@@ -403,7 +403,7 @@ package body Prj.PP is
- Write_String ("library ", Indent);
- when Configuration =>
- Write_String ("configuration ", Indent);
-- when Dry =>
-+ when Abstract_Project =>
- Write_String ("abstract ", Indent);
- end case;
-
-diff --git a/gnat/prj-proc.adb b/gnat/prj-proc.adb
-index 653dbe1..3bad060 100644
---- a/gnat/prj-proc.adb
-+++ b/gnat/prj-proc.adb
-@@ -2,11 +2,11 @@
- -- --
- -- GNAT COMPILER COMPONENTS --
- -- --
---- P R J . P R O C --
-+-- P R J . P R O C --
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2015, 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- --
-@@ -63,6 +63,15 @@ package body Prj.Proc is
- Equal => "=");
- -- This hash table contains all processed projects
-
-+ package Runtime_Defaults is new GNAT.HTable.Simple_HTable
-+ (Header_Num => Prj.Header_Num,
-+ Element => Name_Id,
-+ No_Element => No_Name,
-+ Key => Name_Id,
-+ Hash => Prj.Hash,
-+ Equal => "=");
-+ -- Stores the default values of 'Runtime names for the various languages
-+
- procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
- -- Concatenate two strings and returns another string if both
- -- arguments are not null string.
-@@ -118,9 +127,12 @@ package body Prj.Proc is
- -- of an expression and return it as a Variable_Value.
-
- function Imported_Or_Extended_Project_From
-- (Project : Project_Id;
-- With_Name : Name_Id) return Project_Id;
-- -- Find an imported or extended project of Project whose name is With_Name
-+ (Project : Project_Id;
-+ With_Name : Name_Id;
-+ No_Extending : Boolean := False) return Project_Id;
-+ -- Find an imported or extended project of Project whose name is With_Name.
-+ -- When No_Extending is True, do not look for extending projects, returns
-+ -- the exact project whose name is With_Name.
-
- function Package_From
- (Project : Project_Id;
-@@ -516,6 +528,8 @@ package body Prj.Proc is
- Last : String_List_Id := Nil_String;
- -- Reference to the last string elements in Result, when Kind is List
-
-+ Current_Term_Kind : Project_Node_Kind;
-+
- begin
- Result.Project := Project;
- Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
-@@ -526,12 +540,14 @@ package body Prj.Proc is
- while Present (The_Term) loop
- The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
-
-- case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
-+ if The_Current_Term /= Empty_Node then
-+ Current_Term_Kind :=
-+ Kind_Of (The_Current_Term, From_Project_Node_Tree);
-
-- when N_Literal_String =>
-+ case Current_Term_Kind is
-
-+ when N_Literal_String =>
- case Kind is
--
- when Undefined =>
-
- -- Should never happen
-@@ -562,7 +578,7 @@ package body Prj.Proc is
- else
- Shared.String_Elements.Table
- (Last).Next := String_Element_Table.Last
-- (Shared.String_Elements);
-+ (Shared.String_Elements);
- end if;
-
- Last := String_Element_Table.Last
-@@ -570,8 +586,8 @@ package body Prj.Proc is
-
- Shared.String_Elements.Table (Last) :=
- (Value => String_Value_Of
-- (The_Current_Term,
-- From_Project_Node_Tree),
-+ (The_Current_Term,
-+ From_Project_Node_Tree),
- Index => Source_Index_Of
- (The_Current_Term,
- From_Project_Node_Tree),
-@@ -584,7 +600,6 @@ package body Prj.Proc is
- end case;
-
- when N_Literal_String_List =>
--
- declare
- String_Node : Project_Node_Id :=
- First_Expression_In_List
-@@ -679,7 +694,6 @@ package body Prj.Proc is
- end;
-
- when N_Variable_Reference | N_Attribute_Reference =>
--
- declare
- The_Project : Project_Id := Project;
- The_Package : Package_Id := Pkg;
-@@ -697,6 +711,13 @@ package body Prj.Proc is
- Index : Name_Id := No_Name;
-
- begin
-+ <<Object_Dir_Restart>>
-+ The_Project := Project;
-+ The_Package := Pkg;
-+ The_Name := No_Name;
-+ The_Variable_Id := No_Variable;
-+ Index := No_Name;
-+
- if Present (Term_Project)
- and then Term_Project /= From_Project_Node
- then
-@@ -705,8 +726,9 @@ package body Prj.Proc is
- The_Name :=
- Name_Of (Term_Project, From_Project_Node_Tree);
- The_Project := Imported_Or_Extended_Project_From
-- (Project => Project,
-- With_Name => The_Name);
-+ (Project => Project,
-+ With_Name => The_Name,
-+ No_Extending => True);
- end if;
-
- if Present (Term_Package) then
-@@ -719,7 +741,7 @@ package body Prj.Proc is
- The_Package := The_Project.Decl.Packages;
- while The_Package /= No_Package
- and then Shared.Packages.Table (The_Package).Name /=
-- The_Name
-+ The_Name
- loop
- The_Package :=
- Shared.Packages.Table (The_Package).Next;
-@@ -729,7 +751,7 @@ package body Prj.Proc is
- (The_Package /= No_Package, "package not found.");
-
- elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
-- N_Attribute_Reference
-+ N_Attribute_Reference
- then
- The_Package := No_Package;
- end if;
-@@ -737,9 +759,7 @@ package body Prj.Proc is
- The_Name :=
- Name_Of (The_Current_Term, From_Project_Node_Tree);
-
-- if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
-- N_Attribute_Reference
-- then
-+ if Current_Term_Kind = N_Attribute_Reference then
- Index :=
- Associative_Array_Index_Of
- (The_Current_Term, From_Project_Node_Tree);
-@@ -755,9 +775,7 @@ package body Prj.Proc is
-
- -- First, if there is a package, look into the package
-
-- if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
-- N_Variable_Reference
-- then
-+ if Current_Term_Kind = N_Variable_Reference then
- The_Variable_Id :=
- Shared.Packages.Table
- (The_Package).Decl.Variables;
-@@ -782,9 +800,7 @@ package body Prj.Proc is
-
- -- If we have not found it, look into the project
-
-- if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
-- N_Variable_Reference
-- then
-+ if Current_Term_Kind = N_Variable_Reference then
- The_Variable_Id := The_Project.Decl.Variables;
- else
- The_Variable_Id := The_Project.Decl.Attributes;
-@@ -801,11 +817,23 @@ package body Prj.Proc is
-
- end if;
-
-- pragma Assert (The_Variable_Id /= No_Variable,
-- "variable or attribute not found");
-+ if From_Project_Node_Tree.Incomplete_With then
-+ if The_Variable_Id = No_Variable then
-+ The_Variable := Nil_Variable_Value;
-+ else
-+ The_Variable :=
-+ Shared.Variable_Elements.Table
-+ (The_Variable_Id).Value;
-+ end if;
-
-- The_Variable :=
-- Shared.Variable_Elements.Table (The_Variable_Id).Value;
-+ else
-+ pragma Assert (The_Variable_Id /= No_Variable,
-+ "variable or attribute not found");
-+
-+ The_Variable :=
-+ Shared.Variable_Elements.Table
-+ (The_Variable_Id).Value;
-+ end if;
-
- else
-
-@@ -856,8 +884,8 @@ package body Prj.Proc is
-
- else
- if Expression_Kind_Of
-- (The_Current_Term, From_Project_Node_Tree) =
-- List
-+ (The_Current_Term, From_Project_Node_Tree) =
-+ List
- then
- The_Variable :=
- (Project => Project,
-@@ -878,8 +906,97 @@ package body Prj.Proc is
- end;
- end if;
-
-- case Kind is
-+ -- Check the defaults
-+
-+ if Current_Term_Kind = N_Attribute_Reference then
-+ declare
-+ The_Default : constant Attribute_Default_Value :=
-+ Default_Of
-+ (The_Current_Term, From_Project_Node_Tree);
-+
-+ begin
-+ -- Check the special value for 'Target when specified
-+
-+ if The_Default = Target_Value
-+ and then Opt.Target_Origin = Specified
-+ then
-+ Name_Len := 0;
-+ Add_Str_To_Name_Buffer (Opt.Target_Value.all);
-+ The_Variable.Value := Name_Find;
-+
-+ -- Check the defaults
-+
-+ elsif The_Variable.Default then
-+ case The_Variable.Kind is
-+
-+ when Undefined =>
-+ null;
-+
-+ when Single =>
-+ case The_Default is
-+ when Read_Only_Value =>
-+ null;
-+
-+ when Empty_Value =>
-+ The_Variable.Value := Empty_String;
-+
-+ when Dot_Value =>
-+ The_Variable.Value := Dot_String;
-+
-+ when Object_Dir_Value =>
-+ From_Project_Node_Tree.Project_Nodes.Table
-+ (The_Current_Term).Name :=
-+ Snames.Name_Object_Dir;
-+ From_Project_Node_Tree.Project_Nodes.Table
-+ (The_Current_Term).Default :=
-+ Dot_Value;
-+ goto Object_Dir_Restart;
-
-+ when Target_Value =>
-+ if Opt.Target_Value = null then
-+ The_Variable.Value := Empty_String;
-+
-+ else
-+ Name_Len := 0;
-+ Add_Str_To_Name_Buffer
-+ (Opt.Target_Value.all);
-+ The_Variable.Value := Name_Find;
-+ end if;
-+
-+ when Runtime_Value =>
-+ Get_Name_String (Index);
-+ To_Lower (Name_Buffer (1 .. Name_Len));
-+ The_Variable.Value :=
-+ Runtime_Defaults.Get (Name_Find);
-+ if The_Variable.Value = No_Name then
-+ The_Variable.Value := Empty_String;
-+ end if;
-+
-+ end case;
-+
-+ when List =>
-+ case The_Default is
-+ when Read_Only_Value =>
-+ null;
-+
-+ when Empty_Value =>
-+ The_Variable.Values := Nil_String;
-+
-+ when Dot_Value =>
-+ The_Variable.Values :=
-+ Shared.Dot_String_List;
-+
-+ when Object_Dir_Value |
-+ Target_Value |
-+ Runtime_Value =>
-+ null;
-+ end case;
-+ end case;
-+ end if;
-+ end;
-+ end if;
-+
-+ case Kind is
- when Undefined =>
-
- -- Should never happen
-@@ -888,7 +1005,6 @@ package body Prj.Proc is
- null;
-
- when Single =>
--
- case The_Variable.Kind is
-
- when Undefined =>
-@@ -929,8 +1045,8 @@ package body Prj.Proc is
-
- else
- Shared.String_Elements.Table (Last).Next :=
-- String_Element_Table.Last
-- (Shared.String_Elements);
-+ String_Element_Table.Last
-+ (Shared.String_Elements);
- end if;
-
- Last :=
-@@ -941,8 +1057,8 @@ package body Prj.Proc is
- (Value => The_Variable.Value,
- Display_Value => No_Name,
- Location => Location_Of
-- (The_Current_Term,
-- From_Project_Node_Tree),
-+ (The_Current_Term,
-+ From_Project_Node_Tree),
- Flag => False,
- Next => Nil_String,
- Index => 0);
-@@ -990,7 +1106,7 @@ package body Prj.Proc is
- Index => 0);
-
- The_List := Shared.String_Elements.Table
-- (The_List).Next;
-+ (The_List).Next;
- end loop;
- end;
- end case;
-@@ -1216,10 +1332,10 @@ package body Prj.Proc is
- String_Element_Table.Increment_Last
- (Shared.String_Elements);
- Shared.String_Elements.Table (Last).Next :=
-- String_Element_Table.Last
-- (Shared.String_Elements);
-+ String_Element_Table.Last
-+ (Shared.String_Elements);
- Last := String_Element_Table.Last
-- (Shared.String_Elements);
-+ (Shared.String_Elements);
- end if;
- end loop;
-
-@@ -1248,7 +1364,8 @@ package body Prj.Proc is
- "illegal node kind in an expression");
- raise Program_Error;
-
-- end case;
-+ end case;
-+ end if;
-
- The_Term := Next_Term (The_Term, From_Project_Node_Tree);
- end loop;
-@@ -1261,8 +1378,9 @@ package body Prj.Proc is
- ---------------------------------------
-
- function Imported_Or_Extended_Project_From
-- (Project : Project_Id;
-- With_Name : Name_Id) return Project_Id
-+ (Project : Project_Id;
-+ With_Name : Name_Id;
-+ No_Extending : Boolean := False) return Project_Id
- is
- List : Project_List;
- Result : Project_Id;
-@@ -1304,7 +1422,12 @@ package body Prj.Proc is
- Proj := Result.Extends;
- while Proj /= No_Project loop
- if Proj.Name = With_Name then
-- Temp_Result := Result;
-+ if No_Extending then
-+ Temp_Result := Proj;
-+ else
-+ Temp_Result := Result;
-+ end if;
-+
- exit;
- end if;
-
-@@ -2196,7 +2319,9 @@ package body Prj.Proc is
- Name_Of
- (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
- The_Project :=
-- Imported_Or_Extended_Project_From (Project, Name);
-+ Imported_Or_Extended_Project_From
-+ (Project, Name, No_Extending => True);
-+ The_Package := No_Package;
- end if;
-
- -- If a package was specified for the case variable, get its id
-@@ -2651,6 +2776,10 @@ package body Prj.Proc is
- Success := not Prj.Tree.No (Loaded_Project);
-
- if Success then
-+ if Node_Tree.Incomplete_With then
-+ From_Project_Node_Tree.Incomplete_With := True;
-+ end if;
-+
- List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
- Prj.Initialize (List.Tree);
- List.Tree.Shared := In_Tree.Shared;
-@@ -2814,9 +2943,9 @@ package body Prj.Proc is
- Name : constant Name_Id :=
- Name_Of (From_Project_Node, From_Project_Node_Tree);
-
-- Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
-- Tree_Private_Part.Projects_Htable.Get
-- (From_Project_Node_Tree.Projects_HT, Name);
-+ Display_Name : constant Name_Id :=
-+ Display_Name_Of
-+ (From_Project_Node, From_Project_Node_Tree);
-
- begin
- Project := Processed_Projects.Get (Name);
-@@ -2835,20 +2964,43 @@ package body Prj.Proc is
- return;
- end if;
-
-- Project :=
-- new Project_Data'
-- (Empty_Project
-- (Project_Qualifier_Of
-- (From_Project_Node, From_Project_Node_Tree)));
-+ -- Check if the project is already in the tree
-+
-+ Project := No_Project;
-+
-+ declare
-+ List : Project_List := In_Tree.Projects;
-+ Path : constant Path_Name_Type :=
-+ Path_Name_Of (From_Project_Node,
-+ From_Project_Node_Tree);
-+
-+ begin
-+ while List /= null loop
-+ if List.Project.Path.Display_Name = Path then
-+ Project := List.Project;
-+ exit;
-+ end if;
-
-- -- Note that at this point we do not know yet if the project has
-- -- been withed from an encapsulated library or not.
-+ List := List.Next;
-+ end loop;
-+ end;
-
-- In_Tree.Projects :=
-- new Project_List_Element'
-- (Project => Project,
-- From_Encapsulated_Lib => False,
-- Next => In_Tree.Projects);
-+ if Project = No_Project then
-+ Project :=
-+ new Project_Data'
-+ (Empty_Project
-+ (Project_Qualifier_Of
-+ (From_Project_Node, From_Project_Node_Tree)));
-+
-+ -- Note that at this point we do not know yet if the project
-+ -- has been withed from an encapsulated library or not.
-+
-+ In_Tree.Projects :=
-+ new Project_List_Element'
-+ (Project => Project,
-+ From_Encapsulated_Lib => False,
-+ Next => In_Tree.Projects);
-+ end if;
-
- -- Keep track of this point
-
-@@ -2857,7 +3009,8 @@ package body Prj.Proc is
- Processed_Projects.Set (Name, Project);
-
- Project.Name := Name;
-- Project.Display_Name := Name_Node.Display_Name;
-+ Project.Display_Name := Display_Name;
-+
- Get_Name_String (Name);
-
- -- If name starts with the virtual prefix, flag the project as
-@@ -3012,4 +3165,14 @@ package body Prj.Proc is
- end if;
- end Recursive_Process;
-
-+ -----------------------------
-+ -- Set_Default_Runtime_For --
-+ -----------------------------
-+
-+ procedure Set_Default_Runtime_For (Language : Name_Id; Value : String) is
-+ begin
-+ Name_Len := Value'Length;
-+ Name_Buffer (1 .. Name_Len) := Value;
-+ Runtime_Defaults.Set (Language, Name_Find);
-+ end Set_Default_Runtime_For;
- end Prj.Proc;
-diff --git a/gnat/prj-proc.ads b/gnat/prj-proc.ads
-index 97d7310..face045 100644
---- a/gnat/prj-proc.ads
-+++ b/gnat/prj-proc.ads
-@@ -2,11 +2,11 @@
- -- --
- -- GNAT COMPILER COMPONENTS --
- -- --
---- P R J . P R O C --
-+-- P R J . P R O C --
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -90,4 +90,8 @@ package Prj.Proc is
- On_New_Tree_Loaded : Tree_Loaded_Callback := null);
- -- Performs the two phases of the processing
-
-+ procedure Set_Default_Runtime_For (Language : Name_Id; Value : String);
-+ -- Set the default value for the runtime of Language. To be used for the
-+ -- value of 'Runtime(<Language>) when Runtime (<language>) is not declared.
-+
- end Prj.Proc;
-diff --git a/gnat/prj-strt.adb b/gnat/prj-strt.adb
-index 271a913..8956e97 100644
---- a/gnat/prj-strt.adb
-+++ b/gnat/prj-strt.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2015, 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- --
-@@ -207,6 +207,20 @@ package body Prj.Strt is
-
- Scan (In_Tree);
-
-+ -- Skip a possible index for an associative array
-+
-+ if Token = Tok_Left_Paren then
-+ Scan (In_Tree);
-+
-+ if Token = Tok_String_Literal then
-+ Scan (In_Tree);
-+
-+ if Token = Tok_Right_Paren then
-+ Scan (In_Tree);
-+ end if;
-+ end if;
-+ end if;
-+
- else
- -- Give its characteristics to this attribute reference
-
-@@ -217,7 +231,10 @@ package body Prj.Strt is
- Set_Case_Insensitive
- (Reference, In_Tree,
- To => Attribute_Kind_Of (Current_Attribute) in
-- All_Case_Insensitive_Associative_Array);
-+ All_Case_Insensitive_Associative_Array);
-+ Set_Default_Of
-+ (Reference, In_Tree,
-+ To => Attribute_Default_Of (Current_Attribute));
-
- -- Scan past the attribute name
-
-@@ -292,18 +309,21 @@ package body Prj.Strt is
- ---------------------------
-
- procedure End_Case_Construction
-- (Check_All_Labels : Boolean;
-- Case_Location : Source_Ptr;
-- Flags : Processing_Flags)
-+ (Check_All_Labels : Boolean;
-+ Case_Location : Source_Ptr;
-+ Flags : Processing_Flags;
-+ String_Type : Boolean)
- is
-- Non_Used : Natural := 0;
-+ Non_Used : Natural := 0;
- First_Non_Used : Choice_Node_Id := First_Choice_Node_Id;
-+
- begin
-- -- First, if Check_All_Labels is True, check if all values
-- -- of the string type have been used.
-+ -- First, if Check_All_Labels is True, check if all values of the string
-+ -- type have been used.
-
- if Check_All_Labels then
-- for Choice in Choice_First .. Choices.Last loop
-+ if String_Type then
-+ for Choice in Choice_First .. Choices.Last loop
- if not Choices.Table (Choice).Already_Used then
- Non_Used := Non_Used + 1;
-
-@@ -311,27 +331,34 @@ package body Prj.Strt is
- First_Non_Used := Choice;
- end if;
- end if;
-- end loop;
-+ end loop;
-
-- -- If only one is not used, report a single warning for this value
-+ -- If only one is not used, report a single warning for this value
-
-- if Non_Used = 1 then
-- Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
-- Error_Msg (Flags, "?value %% is not used as label", Case_Location);
-+ if Non_Used = 1 then
-+ Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String;
-+ Error_Msg
-+ (Flags, "?value %% is not used as label", Case_Location);
-
-- -- If several are not used, report a warning for each one of them
-+ -- If several are not used, report a warning for each one of them
-
-- elsif Non_Used > 1 then
-+ elsif Non_Used > 1 then
-+ Error_Msg
-+ (Flags, "?the following values are not used as labels:",
-+ Case_Location);
-+
-+ for Choice in First_Non_Used .. Choices.Last loop
-+ if not Choices.Table (Choice).Already_Used then
-+ Error_Msg_Name_1 := Choices.Table (Choice).The_String;
-+ Error_Msg (Flags, "\?%%", Case_Location);
-+ end if;
-+ end loop;
-+ end if;
-+ else
- Error_Msg
-- (Flags, "?the following values are not used as labels:",
-+ (Flags,
-+ "?no when others for this case construction",
- Case_Location);
--
-- for Choice in First_Non_Used .. Choices.Last loop
-- if not Choices.Table (Choice).Already_Used then
-- Error_Msg_Name_1 := Choices.Table (Choice).The_String;
-- Error_Msg (Flags, "\?%%", Case_Location);
-- end if;
-- end loop;
- end if;
- end if;
-
-@@ -342,18 +369,15 @@ package body Prj.Strt is
- Choices.Set_Last (First_Choice_Node_Id);
- Choice_First := 0;
-
-- elsif Choice_Lasts.Last = 2 then
--
-- -- This is the second case construction, set the tables to the first
-+ -- Second case construction, set the tables to the first
-
-+ elsif Choice_Lasts.Last = 2 then
- Choice_Lasts.Set_Last (1);
- Choices.Set_Last (Choice_Lasts.Table (1));
- Choice_First := 1;
-
-+ -- Third or more case construction, set the tables to the previous one
- else
-- -- This is the 3rd or more case construction, set the tables to the
-- -- previous one.
--
- Choice_Lasts.Decrement_Last;
- Choices.Set_Last (Choice_Lasts.Table (Choice_Lasts.Last));
- Choice_First := Choice_Lasts.Table (Choice_Lasts.Last - 1) + 1;
-@@ -427,7 +451,6 @@ package body Prj.Strt is
- Scan (In_Tree);
-
- case Token is
--
- when Tok_Right_Paren =>
- if Ext_List then
- Error_Msg (Flags, "`,` expected", Token_Ptr);
-@@ -484,7 +507,8 @@ package body Prj.Strt is
- procedure Parse_Choice_List
- (In_Tree : Project_Node_Tree_Ref;
- First_Choice : out Project_Node_Id;
-- Flags : Processing_Flags)
-+ Flags : Processing_Flags;
-+ String_Type : Boolean := True)
- is
- Current_Choice : Project_Node_Id := Empty_Node;
- Next_Choice : Project_Node_Id := Empty_Node;
-@@ -514,38 +538,41 @@ package body Prj.Strt is
-
- Set_String_Value_Of (Current_Choice, In_Tree, To => Choice_String);
-
-- -- Check if the label is part of the string type and if it has not
-- -- been already used.
-+ if String_Type then
-
-- Found := False;
-- for Choice in Choice_First .. Choices.Last loop
-- if Choices.Table (Choice).The_String = Choice_String then
-+ -- Check if the label is part of the string type and if it has not
-+ -- been already used.
-
-- -- This label is part of the string type
-+ Found := False;
-+ for Choice in Choice_First .. Choices.Last loop
-+ if Choices.Table (Choice).The_String = Choice_String then
-
-- Found := True;
-+ -- This label is part of the string type
-
-- if Choices.Table (Choice).Already_Used then
-+ Found := True;
-
-- -- But it has already appeared in a choice list for this
-- -- case construction so report an error.
-+ if Choices.Table (Choice).Already_Used then
-
-- Error_Msg_Name_1 := Choice_String;
-- Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
-+ -- But it has already appeared in a choice list for this
-+ -- case construction so report an error.
-
-- else
-- Choices.Table (Choice).Already_Used := True;
-- end if;
-+ Error_Msg_Name_1 := Choice_String;
-+ Error_Msg (Flags, "duplicate case label %%", Token_Ptr);
-
-- exit;
-- end if;
-- end loop;
-+ else
-+ Choices.Table (Choice).Already_Used := True;
-+ end if;
-+
-+ exit;
-+ end if;
-+ end loop;
-
-- -- If the label is not part of the string list, report an error
-+ -- If the label is not part of the string list, report an error
-
-- if not Found then
-- Error_Msg_Name_1 := Choice_String;
-- Error_Msg (Flags, "illegal case label %%", Token_Ptr);
-+ if not Found then
-+ Error_Msg_Name_1 := Choice_String;
-+ Error_Msg (Flags, "illegal case label %%", Token_Ptr);
-+ end if;
- end if;
-
- -- Scan past the label
-@@ -1162,7 +1189,7 @@ package body Prj.Strt is
-
- -- If we have not found the variable in the package, check if the
- -- variable has been declared in the project, or in any of its
-- -- ancestors.
-+ -- ancestors, or in any of the project it extends.
-
- if No (Current_Variable) then
- declare
-@@ -1182,7 +1209,19 @@ package body Prj.Strt is
-
- exit when Present (Current_Variable);
-
-- Proj := Parent_Project_Of (Proj, In_Tree);
-+ -- If the current project is a child project, check if
-+ -- the variable is declared in its parent. Otherwise, if
-+ -- the current project extends another project, check if
-+ -- the variable is declared in one of the projects the
-+ -- current project extends.
-+
-+ if No (Parent_Project_Of (Proj, In_Tree)) then
-+ Proj :=
-+ Extended_Project_Of
-+ (Project_Declaration_Of (Proj, In_Tree), In_Tree);
-+ else
-+ Proj := Parent_Project_Of (Proj, In_Tree);
-+ end if;
-
- Set_Project_Node_Of (Variable, In_Tree, To => Proj);
-
-diff --git a/gnat/prj-strt.ads b/gnat/prj-strt.ads
-index 7dbe530..ab43346 100644
---- a/gnat/prj-strt.ads
-+++ b/gnat/prj-strt.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -50,27 +50,28 @@ private package Prj.Strt is
- procedure Start_New_Case_Construction
- (In_Tree : Project_Node_Tree_Ref;
- String_Type : Project_Node_Id);
-- -- This procedure is called at the beginning of a case construction The
-+ -- This procedure is called at the beginning of a case construction. The
- -- parameter String_Type is the node for the string type of the case label
- -- variable. The different literal strings of the string type are stored
-- -- into a table to be checked against the case labels of the case
-- -- construction.
-+ -- into a table to be checked against the labels of the case construction.
-
- procedure End_Case_Construction
-- (Check_All_Labels : Boolean;
-- Case_Location : Source_Ptr;
-- Flags : Processing_Flags);
-- -- This procedure is called at the end of a case construction to remove the
-- -- case labels and to restore the previous state. In particular, in the
-+ (Check_All_Labels : Boolean;
-+ Case_Location : Source_Ptr;
-+ Flags : Processing_Flags;
-+ String_Type : Boolean);
-+ -- This procedure is called at the end of a case construction to remove
-+ -- the case labels and to restore the previous state. In particular, in the
- -- case of nested case constructions, the case labels of the enclosing case
-- -- construction are restored. When When_Others is False and we are not in
-+ -- construction are restored. If When_Others is False and we are not in
- -- quiet output, a warning is emitted for each value of the case variable
- -- string type that has not been specified.
-
- procedure Parse_Choice_List
- (In_Tree : Project_Node_Tree_Ref;
- First_Choice : out Project_Node_Id;
-- Flags : Processing_Flags);
-+ Flags : Processing_Flags;
-+ String_Type : Boolean := True);
- -- Get the label for a choice list.
- -- Report an error if
- -- - a case label is not a literal string
-diff --git a/gnat/prj-tree.adb b/gnat/prj-tree.adb
-index 2ff5a9f..75def1c 100644
---- a/gnat/prj-tree.adb
-+++ b/gnat/prj-tree.adb
-@@ -110,25 +110,27 @@ package body Prj.Tree is
- Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
- In_Tree.Project_Nodes.Table
- (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
-- (Kind => N_Comment_Zones,
-- Qualifier => Unspecified,
-- Expr_Kind => Undefined,
-- Location => No_Location,
-- Directory => No_Path,
-- Variables => Empty_Node,
-- Packages => Empty_Node,
-- Pkg_Id => Empty_Package,
-- Name => No_Name,
-- Src_Index => 0,
-- Path_Name => No_Path,
-- Value => No_Name,
-- Field1 => Empty_Node,
-- Field2 => Empty_Node,
-- Field3 => Empty_Node,
-- Field4 => Empty_Node,
-- Flag1 => False,
-- Flag2 => False,
-- Comments => Empty_Node);
-+ (Kind => N_Comment_Zones,
-+ Qualifier => Unspecified,
-+ Expr_Kind => Undefined,
-+ Location => No_Location,
-+ Directory => No_Path,
-+ Variables => Empty_Node,
-+ Packages => Empty_Node,
-+ Pkg_Id => Empty_Package,
-+ Name => No_Name,
-+ Display_Name => No_Name,
-+ Src_Index => 0,
-+ Path_Name => No_Path,
-+ Value => No_Name,
-+ Default => Empty_Value,
-+ Field1 => Empty_Node,
-+ Field2 => Empty_Node,
-+ Field3 => Empty_Node,
-+ Field4 => Empty_Node,
-+ Flag1 => False,
-+ Flag2 => False,
-+ Comments => Empty_Node);
-
- Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
- In_Tree.Project_Nodes.Table (To).Comments := Zone;
-@@ -169,9 +171,11 @@ package body Prj.Tree is
- Packages => Empty_Node,
- Pkg_Id => Empty_Package,
- Name => No_Name,
-+ Display_Name => No_Name,
- Src_Index => 0,
- Path_Name => No_Path,
- Value => Comments.Table (J).Value,
-+ Default => Empty_Value,
- Field1 => Empty_Node,
- Field2 => Empty_Node,
- Field3 => Empty_Node,
-@@ -337,9 +341,11 @@ package body Prj.Tree is
- Packages => Empty_Node,
- Pkg_Id => Empty_Package,
- Name => No_Name,
-+ Display_Name => No_Name,
- Src_Index => 0,
- Path_Name => No_Path,
- Value => No_Name,
-+ Default => Empty_Value,
- Field1 => Empty_Node,
- Field2 => Empty_Node,
- Field3 => Empty_Node,
-@@ -385,6 +391,22 @@ package body Prj.Tree is
- return In_Tree.Project_Nodes.Table (Node).Field1;
- end Current_Term;
-
-+ ----------------
-+ -- Default_Of --
-+ ----------------
-+
-+ function Default_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value
-+ is
-+ begin
-+ pragma Assert
-+ (Present (Node)
-+ and then
-+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference);
-+ return In_Tree.Project_Nodes.Table (Node).Default;
-+ end Default_Of;
-+
- --------------------------
- -- Default_Project_Node --
- --------------------------
-@@ -413,9 +435,11 @@ package body Prj.Tree is
- Packages => Empty_Node,
- Pkg_Id => Empty_Package,
- Name => No_Name,
-+ Display_Name => No_Name,
- Src_Index => 0,
- Path_Name => No_Path,
- Value => No_Name,
-+ Default => Empty_Value,
- Field1 => Empty_Node,
- Field2 => Empty_Node,
- Field3 => Empty_Node,
-@@ -449,9 +473,11 @@ package body Prj.Tree is
- Packages => Empty_Node,
- Pkg_Id => Empty_Package,
- Name => No_Name,
-+ Display_Name => No_Name,
- Src_Index => 0,
- Path_Name => No_Path,
- Value => No_Name,
-+ Default => Empty_Value,
- Field1 => Empty_Node,
- Field2 => Empty_Node,
- Field3 => Empty_Node,
-@@ -483,9 +509,11 @@ package body Prj.Tree is
- Packages => Empty_Node,
- Pkg_Id => Empty_Package,
- Name => No_Name,
-+ Display_Name => No_Name,
- Src_Index => 0,
- Path_Name => No_Path,
- Value => Comments.Table (J).Value,
-+ Default => Empty_Value,
- Field1 => Empty_Node,
- Field2 => Empty_Node,
- Field3 => Empty_Node,
-@@ -1123,6 +1151,7 @@ package body Prj.Tree is
- is
- With_Clause : Project_Node_Id;
- Result : Project_Node_Id := Empty_Node;
-+ Decl : Project_Node_Id;
-
- begin
- -- First check all the imported projects
-@@ -1139,9 +1168,14 @@ package body Prj.Tree is
- return Result;
- end if;
-
-- Result :=
-- Extended_Project_Of
-- (Project_Declaration_Of (Result, In_Tree), In_Tree);
-+ Decl := Project_Declaration_Of (Result, In_Tree);
-+
-+ -- Do not try to check for an extended project, if the project
-+ -- does not have yet a project declaration.
-+
-+ exit when Decl = Empty_Node;
-+
-+ Result := Extended_Project_Of (Decl, In_Tree);
- end loop;
-
- With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
-@@ -1203,6 +1237,22 @@ package body Prj.Tree is
- return In_Tree.Project_Nodes.Table (Node).Name;
- end Name_Of;
-
-+ ---------------------
-+ -- Display_Name_Of --
-+ ---------------------
-+
-+ function Display_Name_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref) return Name_Id
-+ is
-+ begin
-+ pragma Assert
-+ (Present (Node)
-+ and then
-+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
-+ return In_Tree.Project_Nodes.Table (Node).Display_Name;
-+ end Display_Name_Of;
-+
- --------------------
- -- Next_Case_Item --
- --------------------
-@@ -1867,6 +1917,23 @@ package body Prj.Tree is
- In_Tree.Project_Nodes.Table (Node).Field1 := To;
- end Set_Current_Term;
-
-+ --------------------
-+ -- Set_Default_Of --
-+ --------------------
-+
-+ procedure Set_Default_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref;
-+ To : Attribute_Default_Value)
-+ is
-+ begin
-+ pragma Assert
-+ (Present (Node)
-+ and then
-+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference);
-+ In_Tree.Project_Nodes.Table (Node).Default := To;
-+ end Set_Default_Of;
-+
- ----------------------
- -- Set_Directory_Of --
- ----------------------
-@@ -2385,6 +2452,22 @@ package body Prj.Tree is
- In_Tree.Project_Nodes.Table (Node).Name := To;
- end Set_Name_Of;
-
-+ -------------------------
-+ -- Set_Display_Name_Of --
-+ -------------------------
-+
-+ procedure Set_Display_Name_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref;
-+ To : Name_Id)
-+ is
-+ begin
-+ pragma Assert
-+ (Present (Node)
-+ and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
-+ In_Tree.Project_Nodes.Table (Node).Display_Name := To;
-+ end Set_Display_Name_Of;
-+
- -------------------------------
- -- Set_Next_Declarative_Item --
- -------------------------------
-@@ -2910,6 +2993,7 @@ package body Prj.Tree is
- begin
- Project := Default_Project_Node (In_Tree, N_Project);
- Set_Name_Of (Project, In_Tree, Name);
-+ Set_Display_Name_Of (Project, In_Tree, Name);
- Set_Directory_Of
- (Project, In_Tree,
- Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
-@@ -2929,7 +3013,6 @@ package body Prj.Tree is
- Name,
- Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
- (Name => Name,
-- Display_Name => Name,
- Resolved_Path => No_Path,
- Node => Project,
- Extended => False,
-diff --git a/gnat/prj-tree.ads b/gnat/prj-tree.ads
-index 0a7da7f..e012d37 100644
---- a/gnat/prj-tree.ads
-+++ b/gnat/prj-tree.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -269,6 +269,12 @@ package Prj.Tree is
- -- Valid for all non empty nodes. May return No_Name for nodes that have
- -- no names.
-
-+ function Display_Name_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref) return Name_Id;
-+ pragma Inline (Display_Name_Of);
-+ -- Valid only for N_Project node. Returns the display name of the project.
-+
- function Kind_Of
- (Node : Project_Node_Id;
- In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind;
-@@ -590,6 +596,12 @@ package Prj.Tree is
- -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
- -- May return Empty_Node.
-
-+ function Default_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref) return Attribute_Default_Value;
-+ pragma Inline (Default_Of);
-+ -- Only valid for N_Attribute_Reference nodes
-+
- function String_Type_Of
- (Node : Project_Node_Id;
- In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-@@ -732,7 +744,14 @@ package Prj.Tree is
- In_Tree : Project_Node_Tree_Ref;
- To : Name_Id);
- pragma Inline (Set_Name_Of);
-- -- Valid for all non empty nodes.
-+ -- Valid for all non empty nodes
-+
-+ procedure Set_Display_Name_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref;
-+ To : Name_Id);
-+ pragma Inline (Set_Display_Name_Of);
-+ -- Valid only for N_Project nodes
-
- procedure Set_Kind_Of
- (Node : Project_Node_Id;
-@@ -1068,7 +1087,14 @@ package Prj.Tree is
- In_Tree : Project_Node_Tree_Ref;
- To : Project_Node_Id);
- pragma Inline (Set_Package_Node_Of);
-- -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
-+ -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes
-+
-+ procedure Set_Default_Of
-+ (Node : Project_Node_Id;
-+ In_Tree : Project_Node_Tree_Ref;
-+ To : Attribute_Default_Value);
-+ pragma Inline (Set_Default_Of);
-+ -- Only valid for N_Attribute_Reference nodes
-
- procedure Set_String_Type_Of
- (Node : Project_Node_Id;
-@@ -1146,6 +1172,9 @@ package Prj.Tree is
- Directory : Path_Name_Type := No_Path;
- -- Only for N_Project
-
-+ Display_Name : Name_Id := No_Name;
-+ -- Only for N_Project
-+
- Expr_Kind : Variable_Kind := Undefined;
- -- See below for what Project_Node_Kind it is used
-
-@@ -1179,6 +1208,9 @@ package Prj.Tree is
- Value : Name_Id := No_Name;
- -- See below for what Project_Node_Kind it is used
-
-+ Default : Attribute_Default_Value := Empty_Value;
-+ -- Only used in N_Attribute_Reference
-+
- Field1 : Project_Node_Id := Empty_Node;
- -- See below the meaning for each Project_Node_Kind
-
-@@ -1463,9 +1495,6 @@ package Prj.Tree is
- Name : Name_Id;
- -- Name of the project
-
-- Display_Name : Name_Id;
-- -- The name of the project as it appears in the .gpr file
--
- Node : Project_Node_Id;
- -- Node of the project in table Project_Nodes
-
-@@ -1486,7 +1515,6 @@ package Prj.Tree is
-
- No_Project_Name_And_Node : constant Project_Name_And_Node :=
- (Name => No_Name,
-- Display_Name => No_Name,
- Node => Empty_Node,
- Resolved_Path => No_Path,
- Extended => True,
-diff --git a/gnat/prj-util.adb b/gnat/prj-util.adb
-index d369ae2..447818d 100644
---- a/gnat/prj-util.adb
-+++ b/gnat/prj-util.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2001-2014, 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- --
-@@ -467,7 +467,8 @@ package body Prj.Util is
- -- the interface for standalone libraries.
-
- if Sid.Kind = Spec
-- and then not Sid.Project.Externally_Built
-+ and then (not Sid.Project.Externally_Built
-+ or else Sid.Project = Project)
- and then not Sid.Locally_Removed
- and then (Project.Standalone_Library = No
- or else Sid.Declared_In_Interfaces)
-diff --git a/gnat/prj.adb b/gnat/prj.adb
-index e4c7784..9da0f44 100644
---- a/gnat/prj.adb
-+++ b/gnat/prj.adb
-@@ -23,7 +23,6 @@
- -- --
- ------------------------------------------------------------------------------
-
--with Debug;
- with Opt;
- with Osint; use Osint;
- with Output; use Output;
-@@ -61,6 +60,7 @@ package body Prj is
- -- Initial size for extensible buffer used in Add_To_Buffer
-
- The_Empty_String : Name_Id := No_Name;
-+ The_Dot_String : Name_Id := No_Name;
-
- Debug_Level : Integer := 0;
- -- Current indentation level for debug traces
-@@ -187,7 +187,7 @@ package body Prj is
- pragma Warnings (Off, Dont_Care);
-
- begin
-- if not Debug.Debug_Flag_N then
-+ if not Opt.Keep_Temporary_Files then
- if Current_Verbosity = High then
- Write_Line ("Removing temp file: " & Get_Name_String (Path));
- end if;
-@@ -217,7 +217,7 @@ package body Prj is
- Proj : Project_List;
-
- begin
-- if not Debug.Debug_Flag_N then
-+ if not Opt.Keep_Temporary_Files then
- if Project_Tree /= null then
- Proj := Project_Tree.Projects;
- while Proj /= null loop
-@@ -254,7 +254,7 @@ package body Prj is
- Path : Path_Name_Type;
-
- begin
-- if not Debug.Debug_Flag_N then
-+ if not Opt.Keep_Temporary_Files then
- for Index in
- 1 .. Temp_Files_Table.Last (Shared.Private_Part.Temp_Files)
- loop
-@@ -276,8 +276,7 @@ package body Prj is
-
- -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or
- -- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to
-- -- the empty string. On VMS, this has the effect of deassigning
-- -- the logical names.
-+ -- the empty string.
-
- if Shared.Private_Part.Current_Source_Path_File /= No_Path then
- Setenv (Project_Include_Path_File, "");
-@@ -310,6 +309,15 @@ package body Prj is
- end Dependency_Name;
-
- ----------------
-+ -- Dot_String --
-+ ----------------
-+
-+ function Dot_String return Name_Id is
-+ begin
-+ return The_Dot_String;
-+ end Dot_String;
-+
-+ ----------------
- -- Empty_File --
- ----------------
-
-@@ -1059,6 +1067,10 @@ package body Prj is
- Name_Len := 0;
- The_Empty_String := Name_Find;
-
-+ Name_Len := 1;
-+ Name_Buffer (1) := '.';
-+ The_Dot_String := Name_Find;
-+
- Prj.Attr.Initialize;
-
- -- Make sure that new reserved words after Ada 95 may be used as
-@@ -1444,6 +1456,20 @@ package body Prj is
- Array_Table.Init (Tree.Shared.Arrays);
- Package_Table.Init (Tree.Shared.Packages);
-
-+ -- Create Dot_String_List
-+
-+ String_Element_Table.Append
-+ (Tree.Shared.String_Elements,
-+ String_Element'
-+ (Value => The_Dot_String,
-+ Index => 0,
-+ Display_Value => The_Dot_String,
-+ Location => No_Location,
-+ Flag => False,
-+ Next => Nil_String));
-+ Tree.Shared.Dot_String_List :=
-+ String_Element_Table.Last (Tree.Shared.String_Elements);
-+
- -- Private part table
-
- Temp_Files_Table.Init (Tree.Shared.Private_Part.Temp_Files);
-@@ -1714,7 +1740,7 @@ package body Prj is
- Context : Project_Context;
- Dummy : in out Boolean)
- is
-- pragma Unreferenced (Dummy, Tree);
-+ pragma Unreferenced (Tree);
-
- List : Project_List;
- Prj2 : Project_Id;
-@@ -1908,7 +1934,8 @@ package body Prj is
- Require_Obj_Dirs => Require_Obj_Dirs,
- Allow_Invalid_External => Allow_Invalid_External,
- Missing_Source_Files => Missing_Source_Files,
-- Ignore_Missing_With => Ignore_Missing_With);
-+ Ignore_Missing_With => Ignore_Missing_With,
-+ Incomplete_Withs => False);
- end Create_Flags;
-
- ------------
-@@ -2101,7 +2128,7 @@ package body Prj is
-
- if Project.Qualifier in Aggregate_Project then
- Ctx :=
-- (In_Aggregate_Lib => True,
-+ (In_Aggregate_Lib => Project.Qualifier = Aggregate_Library,
- From_Encapsulated_Lib =>
- Context.From_Encapsulated_Lib
- or else Project.Standalone_Library = Encapsulated);
-@@ -2121,6 +2148,18 @@ package body Prj is
- (Root_Project, Root_Tree, Project_Context'(False, False));
- end For_Project_And_Aggregated_Context;
-
-+ -----------------------------
-+ -- Set_Ignore_Missing_With --
-+ -----------------------------
-+
-+ procedure Set_Ignore_Missing_With
-+ (Flags : in out Processing_Flags;
-+ Value : Boolean)
-+ is
-+ begin
-+ Flags.Ignore_Missing_With := Value;
-+ end Set_Ignore_Missing_With;
-+
- -- Package initialization for Prj
-
- begin
-diff --git a/gnat/prj.ads b/gnat/prj.ads
-index ce6e01e..ac55681 100644
---- a/gnat/prj.ads
-+++ b/gnat/prj.ads
-@@ -72,6 +72,16 @@ package Prj is
- type Yes_No_Unknown is (Yes, No, Unknown);
- -- Tri-state to decide if -lgnarl is needed when linking
-
-+ type Attribute_Default_Value is
-+ (Read_Only_Value, -- For read only attributes (Name, Project_Dir)
-+ Empty_Value, -- Empty string or empty string list
-+ Dot_Value, -- "." or (".")
-+ Object_Dir_Value, -- 'Object_Dir
-+ Target_Value, -- 'Target (special rules)
-+ Runtime_Value); -- 'Runtime (special rules)
-+ -- Describe the default values of attributes that are referenced but not
-+ -- declared.
-+
- pragma Warnings (Off);
- type Project_Qualifier is
- (Unspecified,
-@@ -83,7 +93,7 @@ package Prj is
-
- Library,
- Configuration,
-- Dry,
-+ Abstract_Project,
- Aggregate,
- Aggregate_Library);
- pragma Warnings (On);
-@@ -91,7 +101,7 @@ package Prj is
- -- file:
- -- Standard: standard project ...
- -- Library: library project is ...
-- -- Dry: abstract project is
-+ -- Abstract_Project: abstract project is
- -- Aggregate: aggregate project is
- -- Aggregate_Library: aggregate library project is ...
- -- Configuration: configuration project is ...
-@@ -123,6 +133,9 @@ package Prj is
- function Empty_String return Name_Id;
- -- Return the id for an empty string ""
-
-+ function Dot_String return Name_Id;
-+ -- Return the id for "."
-+
- type Path_Information is record
- Name : Path_Name_Type := No_Path;
- Display_Name : Path_Name_Type := No_Path;
-@@ -441,10 +454,8 @@ package Prj is
- No_Source : constant Source_Id := null;
-
- type Path_Syntax_Kind is
-- (Canonical,
-- -- Unix style
-- Host);
-- -- Host specific syntax, for example on VMS (the default)
-+ (Canonical, -- Unix style
-+ Host); -- Host specific syntax
-
- -- The following record describes the configuration of a language
-
-@@ -484,8 +495,7 @@ package Prj is
- -- unit in a multi-source file, in the object file name.
-
- Path_Syntax : Path_Syntax_Kind := Host;
-- -- Value may be Canonical (Unix style) or Host (host syntax, for example
-- -- on VMS for DEC C).
-+ -- Value may be Canonical (Unix style) or Host (host syntax)
-
- Source_File_Switches : Name_List_Index := No_Name_List;
- -- Optional switches to be put before the source file. The source file
-@@ -1573,6 +1583,7 @@ package Prj is
- Arrays : Array_Table.Instance;
- Packages : Package_Table.Instance;
- Private_Part : Private_Project_Tree_Data;
-+ Dot_String_List : String_List_Id := Nil_String;
- end record;
- type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data;
- -- The data that is shared among multiple trees, when these trees are
-@@ -1882,10 +1893,16 @@ package Prj is
- -- * user project also includes a "with" that can only be resolved
- -- once we have found the gnatls
-
-- Gprbuild_Flags : constant Processing_Flags;
-- Gprclean_Flags : constant Processing_Flags;
-- Gprexec_Flags : constant Processing_Flags;
-- Gnatmake_Flags : constant Processing_Flags;
-+ procedure Set_Ignore_Missing_With
-+ (Flags : in out Processing_Flags;
-+ Value : Boolean);
-+ -- Set the value of component Ignore_Missing_With in Flags to Value
-+
-+ Gprbuild_Flags : constant Processing_Flags;
-+ Gprinstall_Flags : constant Processing_Flags;
-+ Gprclean_Flags : constant Processing_Flags;
-+ Gprexec_Flags : constant Processing_Flags;
-+ Gnatmake_Flags : constant Processing_Flags;
- -- Flags used by the various tools. They all display the error messages
- -- through Prj.Err.
-
-@@ -1951,7 +1968,6 @@ package Prj is
- -- indentation level only affects output done through Debug_Output.
-
- private
--
- All_Packages : constant String_List_Access := null;
-
- No_Project_Tree : constant Project_Tree_Ref := null;
-@@ -1991,14 +2007,18 @@ private
- Last : in out Natural);
- -- Append a String to the Buffer
-
-+ -- Table used to store the path name of all the created temporary files, so
-+ -- that they can be deleted at the end, or when the program is interrupted.
-+
- package Temp_Files_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Path_Name_Type,
- Table_Index_Type => Integer,
- Table_Low_Bound => 1,
- Table_Initial => 10,
- Table_Increment => 10);
-- -- Table to store the path name of all the created temporary files, so that
-- -- they can be deleted at the end, or when the program is interrupted.
-+
-+ -- The following type is used to represent the part of a project tree which
-+ -- is private to the Project Manager.
-
- type Private_Project_Tree_Data is record
- Temp_Files : Temp_Files_Table.Instance;
-@@ -2008,18 +2028,17 @@ private
- Current_Source_Path_File : Path_Name_Type := No_Path;
- -- Current value of project source path file env var. Used to avoid
- -- setting the env var to the same value. When different from No_Path,
-- -- this indicates that logical names (VMS) or environment variables were
-- -- created and should be deassigned to avoid polluting the environment
-- -- on VMS. This is for gnatmake only.
-+ -- this indicates that environment variables were created and should be
-+ -- deassigned to avoid polluting the environment. For gnatmake only.
-
- Current_Object_Path_File : Path_Name_Type := No_Path;
- -- Current value of project object path file env var. Used to avoid
- -- setting the env var to the same value.
- -- gnatmake only
--
- end record;
-- -- Type to represent the part of a project tree which is private to the
-- -- Project Manager.
-+
-+ -- The following type is used to hold processing flags which show what
-+ -- functions are required for the various tools that are handled.
-
- type Processing_Flags is record
- Require_Sources_Other_Lang : Boolean;
-@@ -2032,54 +2051,76 @@ private
- Allow_Invalid_External : Error_Warning;
- Missing_Source_Files : Error_Warning;
- Ignore_Missing_With : Boolean;
-+
-+ Incomplete_Withs : Boolean := False;
-+ -- This flag is set to True when the projects are parsed while ignoring
-+ -- missing withed project and some withed projects are not found.
-+
- end record;
-
-- Gprbuild_Flags : constant Processing_Flags :=
-- (Report_Error => null,
-- When_No_Sources => Warning,
-- Require_Sources_Other_Lang => True,
-- Allow_Duplicate_Basenames => False,
-- Compiler_Driver_Mandatory => True,
-- Error_On_Unknown_Language => True,
-- Require_Obj_Dirs => Error,
-- Allow_Invalid_External => Error,
-- Missing_Source_Files => Error,
-- Ignore_Missing_With => False);
--
-- Gprclean_Flags : constant Processing_Flags :=
-- (Report_Error => null,
-- When_No_Sources => Warning,
-- Require_Sources_Other_Lang => True,
-- Allow_Duplicate_Basenames => False,
-- Compiler_Driver_Mandatory => True,
-- Error_On_Unknown_Language => True,
-- Require_Obj_Dirs => Warning,
-- Allow_Invalid_External => Error,
-- Missing_Source_Files => Error,
-- Ignore_Missing_With => False);
--
-- Gprexec_Flags : constant Processing_Flags :=
-- (Report_Error => null,
-- When_No_Sources => Silent,
-- Require_Sources_Other_Lang => False,
-- Allow_Duplicate_Basenames => False,
-- Compiler_Driver_Mandatory => False,
-- Error_On_Unknown_Language => True,
-- Require_Obj_Dirs => Silent,
-- Allow_Invalid_External => Error,
-- Missing_Source_Files => Silent,
-- Ignore_Missing_With => False);
--
-- Gnatmake_Flags : constant Processing_Flags :=
-- (Report_Error => null,
-- When_No_Sources => Error,
-- Require_Sources_Other_Lang => False,
-- Allow_Duplicate_Basenames => False,
-- Compiler_Driver_Mandatory => False,
-- Error_On_Unknown_Language => False,
-- Require_Obj_Dirs => Error,
-- Allow_Invalid_External => Error,
-- Missing_Source_Files => Error,
-- Ignore_Missing_With => False);
-+ Gprbuild_Flags : constant Processing_Flags :=
-+ (Report_Error => null,
-+ When_No_Sources => Warning,
-+ Require_Sources_Other_Lang => True,
-+ Allow_Duplicate_Basenames => False,
-+ Compiler_Driver_Mandatory => True,
-+ Error_On_Unknown_Language => True,
-+ Require_Obj_Dirs => Error,
-+ Allow_Invalid_External => Error,
-+ Missing_Source_Files => Error,
-+ Ignore_Missing_With => False,
-+ Incomplete_Withs => False);
-+
-+ Gprinstall_Flags : constant Processing_Flags :=
-+ (Report_Error => null,
-+ When_No_Sources => Warning,
-+ Require_Sources_Other_Lang => True,
-+ Allow_Duplicate_Basenames => False,
-+ Compiler_Driver_Mandatory => True,
-+ Error_On_Unknown_Language => True,
-+ Require_Obj_Dirs => Silent,
-+ Allow_Invalid_External => Error,
-+ Missing_Source_Files => Error,
-+ Ignore_Missing_With => False,
-+ Incomplete_Withs => False);
-+
-+ Gprclean_Flags : constant Processing_Flags :=
-+ (Report_Error => null,
-+ When_No_Sources => Warning,
-+ Require_Sources_Other_Lang => True,
-+ Allow_Duplicate_Basenames => False,
-+ Compiler_Driver_Mandatory => True,
-+ Error_On_Unknown_Language => True,
-+ Require_Obj_Dirs => Warning,
-+ Allow_Invalid_External => Error,
-+ Missing_Source_Files => Error,
-+ Ignore_Missing_With => False,
-+ Incomplete_Withs => False);
-+
-+ Gprexec_Flags : constant Processing_Flags :=
-+ (Report_Error => null,
-+ When_No_Sources => Silent,
-+ Require_Sources_Other_Lang => False,
-+ Allow_Duplicate_Basenames => False,
-+ Compiler_Driver_Mandatory => False,
-+ Error_On_Unknown_Language => True,
-+ Require_Obj_Dirs => Silent,
-+ Allow_Invalid_External => Error,
-+ Missing_Source_Files => Silent,
-+ Ignore_Missing_With => False,
-+ Incomplete_Withs => False);
-+
-+ Gnatmake_Flags : constant Processing_Flags :=
-+ (Report_Error => null,
-+ When_No_Sources => Error,
-+ Require_Sources_Other_Lang => False,
-+ Allow_Duplicate_Basenames => False,
-+ Compiler_Driver_Mandatory => False,
-+ Error_On_Unknown_Language => False,
-+ Require_Obj_Dirs => Error,
-+ Allow_Invalid_External => Error,
-+ Missing_Source_Files => Error,
-+ Ignore_Missing_With => False,
-+ Incomplete_Withs => False);
-
- end Prj;
-diff --git a/gnat/projects.texi b/gnat/projects.texi
-index d66ed9a..aa12e5b 100644
---- a/gnat/projects.texi
-+++ b/gnat/projects.texi
-@@ -41,7 +41,7 @@ project files allow you to specify:
- @item The directory in which the compiler's output
- (@file{ALI} files, object files, tree files, etc.) is to be placed
- @item The directory in which the executable programs are to be placed
-- at item ^Switch^Switch^ settings for any of the project-enabled tools;
-+ at item Switch settings for any of the project-enabled tools;
- you can apply these settings either globally or to individual compilation units.
- @item The source files containing the main subprogram(s) to be built
- @item The source programming language(s)
-@@ -68,7 +68,7 @@ Subsystems}).
- More generally, the Project Manager lets you structure large development
- efforts into hierarchical subsystems, where build decisions are delegated
- to the subsystem level, and thus different compilation environments
-- (^switch^switch^ settings) used for different subsystems.
-+ (switch settings) used for different subsystems.
- @item You can organize GNAT projects in a hierarchy: a child project
- can extend a parent project, inheriting the parent's source files and
- optionally overriding any of them with alternative versions
-@@ -80,8 +80,8 @@ Subsystems}).
- Several tools support project files, generally in addition to specifying
- the information on the command line itself). They share common switches
- to control the loading of the project (in particular
-- at option{^-P^/PROJECT_FILE=^@emph{projectfile}} and
-- at option{^-X^/EXTERNAL_REFERENCE=^@emph{vbl}=@emph{value}}).
-+ at option{-P at emph{projectfile}} and
-+ at option{-X at emph{vbl}=@emph{value}}).
-
- The Project Manager supports a wide range of development strategies,
- for systems of all sizes. Here are some typical practices that are
-@@ -89,15 +89,14 @@ easily handled:
-
- @itemize @bullet
- @item Using a common set of source files and generating object files in different
-- directories via different ^switch^switch^ settings. It can be used for instance, for
-+ directories via different switch settings. It can be used for instance, for
- generating separate sets of object files for debugging and for production.
- @item Using a mostly-shared set of source files with different versions of
- some units or subunits. It can be used for instance, for grouping and hiding
-+ all OS dependencies in a small number of implementation units.
- @end itemize
-
- @noindent
--all OS dependencies in a small number of implementation units.
--
- Project files can be used to achieve some of the effects of a source
- versioning system (for example, defining separate projects for
- the different sets of sources that comprise different releases) but the
-@@ -174,7 +173,6 @@ detailed later in this documentation. They are summarized here as a reference.
- @b{Object_Dir} attribute. In order to store objects in
- two or more object directories, the system must be split into
- distinct subsystems with their own project file.
--/first exam
-
- @end table
-
-@@ -185,19 +183,19 @@ following examples.
- The Ada source files @file{pack.ads}, @file{pack.adb}, and @file{proc.adb} are in
- the @file{common/} directory. The file @file{proc.adb} contains an Ada main
- subprogram @code{Proc} that @code{with}s package @code{Pack}. We want to compile
--these source files with the ^switch^switch^
-- at option{^-O2^-O2^}, and put the resulting files in
-+these source files with the switch
-+ at option{-O2}, and put the resulting files in
- the directory @file{obj/}.
-
- @smallexample
- @group
--^common/^[COMMON]^
-+common/
- pack.ads
- pack.adb
- proc.adb
- @end group
- @group
--^common/release/^[COMMON.RELEASE]^
-+common/obj/
- proc.ali, proc.o pack.ali, pack.o
- @end group
- @end smallexample
-@@ -238,12 +236,12 @@ should contain the following code:
-
- @noindent
- When you create a new project, the first thing to describe is how to find the
--corresponding source files. This is the only settings that are needed by all
-+corresponding source files. These are the only settings that are needed by all
- the tools that will use this project (builder, compiler, binder and linker for
- the compilation, IDEs to edit the source files, at dots{}).
-
- @cindex Source directories
--First step is to declare the source directories, which are the directories
-+The first step is to declare the source directories, which are the directories
- to be searched to find source files. In the case of the example,
- the @file{common} directory is the only source directory.
-
-@@ -266,15 +264,16 @@ There are several ways of defining source directories:
- @cindex portability
- The syntax for directories is platform specific. For portability, however,
- the project manager will always properly translate UNIX-like path names to
-- the native format of specific platform. For instance, when the same project
-- file is to be used both on Unix and Windows, "/" should be used as the
-- directory separator rather than "\".
-+ the native format of the specific platform. For instance, when the same
-+ project file is to be used both on Unix and Windows, "/" should be used as
-+ the directory separator rather than "\".
-
- @item The attribute @b{Source_Dirs} can automatically include subdirectories
-- using a special syntax inspired by some UNIX shells. If any of the path in
-- the list ends with @emph{"**"}, then that path and all its subdirectories
-+ using a special syntax inspired by some UNIX shells. If any of the paths in
-+ the list ends with "@file{**}", then that path and all its subdirectories
- (recursively) are included in the list of source directories. For instance,
-- @file{**} and @file{./**} represent the complete directory tree rooted at ".".
-+ @file{**} and @file{./**} represent the complete directory tree rooted at
-+ the directory in which the project file resides.
- @cindex Source directories, recursive
-
- @cindex @code{Excluded_Source_Dirs}
-@@ -321,7 +320,7 @@ their absolute or relative path names. The project manager is in charge of
- locating the specified source files in the specified source directories.
-
- @itemize @bullet
-- at item By default, the project manager search for all source files of all
-+ at item By default, the project manager searches for all source files of all
- specified languages in all the source directories.
-
- Since the project manager was initially developed for Ada environments, the
-@@ -415,15 +414,14 @@ to it and this is not explicitly indicated in the project file.
- @noindent
- If the order of the source directories is known statically, that is if
- @code{"/**"} is not used in the string list @code{Source_Dirs}, then there may
--be several files with the same source file name sitting in different
--directories of the project. In this case, only the file in the first directory
--is considered as a source of the project and the others are hidden. If
-- at code{"/**"} is used in the string list @code{Source_Dirs}, it is an error
--to have several files with the same source file name in the same directory
-- at code{"/**"} subtree, since there would be an ambiguity as to which one should
--be used. However, two files with the same source file name may exist in two
--single directories or directory subtrees. In this case, the one in the first
--directory or directory subtree is a source of the project.
-+be several files with the same name sitting in different directories of the
-+project. In this case, only the file in the first directory is considered as a
-+source of the project and the others are hidden. If @code{"/**"} is used in the
-+string list @code{Source_Dirs}, it is an error to have several files with the
-+same name in the same directory @code{"/**"} subtree, since there would be an
-+ambiguity as to which one should be used. However, two files with the same name
-+may exist in two single directories or directory subtrees. In this case, the
-+one in the first directory or directory subtree is a source of the project.
-
- If there are two sources in different directories of the same @code{"/**"}
- subtree, one way to resolve the problem is to exclude the directory of the
-@@ -450,7 +448,7 @@ Its value is the path to the object directory, either absolute or
- relative to the directory containing the project file. This
- directory must already exist and be readable and writable, although
- some tools have a switch to create the directory if needed (See
--the switch @code{^-p^/CREATE_MISSING_DIRS^} for @command{gnatmake}
-+the switch @code{-p} for @command{gnatmake}
- and @command{gprbuild}).
-
- If the attribute @code{Object_Dir} is not specified, it defaults to
-@@ -467,11 +465,11 @@ For our example, we can specify the object dir in this way:
-
- @noindent
- As mentioned earlier, there is a single object directory per project. As a
--result, if you have an existing system where the object files are spread in
-+result, if you have an existing system where the object files are spread across
- several directories, you can either move all of them into the same directory if
- you want to build it with a single project file, or study the section on
- subsystems (@pxref{Organizing Projects into Subsystems}) to see how each
--separate object directory can be associated with one of the subsystem
-+separate object directory can be associated with one of the subsystems
- constituting the application.
-
- When the @command{linker} is called, it usually creates an executable. By
-@@ -506,7 +504,7 @@ the project file is now
- @noindent
- In the previous section, executables were mentioned. The project manager needs
- to be taught what they are. In a project file, an executable is indicated by
--pointing to source file of the main subprogram. In C this is the file that
-+pointing to the source file of a main subprogram. In C this is the file that
- contains the @code{main} function, and in Ada the file that contains the main
- unit.
-
-@@ -515,8 +513,8 @@ several executables can be built in the context of a single project file. Of
- course, one given executable might not (and in fact will not) need all the
- source files referenced by the project. As opposed to other build environments
- such as @command{makefile}, one does not need to specify the list of
--dependencies of each executable, the project-aware builders knows enough of the
--semantics of the languages to build ands link only the necessary elements.
-+dependencies of each executable, the project-aware builder knows enough of the
-+semantics of the languages to build and link only the necessary elements.
-
- @cindex @code{Main}
- The list of main files is specified via the @b{Main} attribute. It contains
-@@ -540,7 +538,7 @@ If this attribute is defined in the project, then spawning the builder
- with a command such as
-
- @smallexample
-- gnatmake ^-Pbuild^/PROJECT_FILE=build^
-+ gprbuild -Pbuild
- @end smallexample
-
- @noindent
-@@ -555,32 +553,31 @@ or more executables on the command line to build a subset of them.
-
- @noindent
- We now have a project file that fully describes our environment, and can be
--used to build the application with a simple @command{gnatmake} command as seen
-+used to build the application with a simple @command{gprbuild} command as seen
- in the previous section. In fact, the empty project we showed immediately at
- the beginning (with no attribute at all) could already fulfill that need if it
- was put in the @file{common} directory.
-
--Of course, we always want more control. This section will show you how to
--specify the compilation switches that the various tools involved in the
--building of the executable should use.
-+Of course, we might want more control. This section shows you how to specify
-+the compilation switches that the various tools involved in the building of the
-+executable should use.
-
- @cindex command line length
--Since source names and locations are described into the project file, it is not
-+Since source names and locations are described in the project file, it is not
- necessary to use switches on the command line for this purpose (switches such
- as -I for gcc). This removes a major source of command line length overflow.
- Clearly, the builders will have to communicate this information one way or
- another to the underlying compilers and tools they call but they usually use
--response files for this and thus should not be subject to command line
--overflows.
-+response files for this and thus are not subject to command line overflows.
-
--Several tools are participating to the creation of an executable: the compiler
-+Several tools participate to the creation of an executable: the compiler
- produces object files from the source files; the binder (in the Ada case)
--creates an source file that takes care, among other things, of elaboration
--issues and global variables initialization; and the linker gathers everything
--into a single executable that users can execute. All these tools are known by
-+creates a "source" file that takes care, among other things, of elaboration
-+issues and global variable initialization; and the linker gathers everything
-+into a single executable that users can execute. All these tools are known to
- the project manager and will be called with user defined switches from the
- project files. However, we need to introduce a new project file concept to
--express which switches to be used for any of the tools involved in the build.
-+express the switches to be used for any of the tools involved in the build.
-
- @cindex project file packages
- A project file is subdivided into zero or more @b{packages}, each of which
-@@ -617,13 +614,13 @@ packages would be involved in the build process.
-
- @noindent
- Let's first examine the compiler switches. As stated in the initial description
--of the example, we want to compile all files with @option{^-O2^-O2^}. This is a
-+of the example, we want to compile all files with @option{-O2}. This is a
- compiler switch, although it is usual, on the command line, to pass it to the
- builder which then passes it to the compiler. It is recommended to use directly
- the right package, which will make the setup easier to understand for other
- people.
-
--Several attributes can be used to specify the ^switches^switches^:
-+Several attributes can be used to specify the switches:
-
- @table @asis
- @item @b{Default_Switches}:
-@@ -636,22 +633,22 @@ Several attributes can be used to specify the ^switches^switches^:
- likely be used for each language, and each compiler has its own set of
- switches). The value of the attribute is a list of switches.
-
-- In this example, we want to compile all Ada source files with the ^switch^switch^
-- @option{^-O2^-O2^}, and the resulting project file is as follows
-+ In this example, we want to compile all Ada source files with the switch
-+ @option{-O2}, and the resulting project file is as follows
- (only the @code{Compiler} package is shown):
-
- @smallexample
- @b{package} Compiler @b{is}
-- @b{for} Default_Switches ("Ada") @b{use} ("^-O2^-O2^");
-+ @b{for} Default_Switches ("Ada") @b{use} ("-O2");
- @b{end} Compiler;
- @end smallexample
-
-- at item @b{^Switches^Switches^}:
-- at cindex @code{^Switches^Switches^}
-- in some cases, we might want to use specific ^switches^switches^
-+ at item @b{Switches}:
-+ at cindex @code{Switches}
-+ in some cases, we might want to use specific switches
- for one or more files. For instance, compiling @file{proc.adb} might not be
- possible at high level of optimization because of a compiler issue.
-- In such a case, the @emph{^Switches^Switches^}
-+ In such a case, the @emph{Switches}
- attribute (indexed on the file name) can be used and will override the
- switches defined by @emph{Default_Switches}. Our project file would
- become:
-@@ -659,30 +656,30 @@ Several attributes can be used to specify the ^switches^switches^:
- @smallexample
- package Compiler is
- for Default_Switches ("Ada")
-- use ("^-O2^-O2^");
-- for ^Switches^Switches^ ("proc.adb")
-- use ("^-O0^-O0^");
-+ use ("-O2");
-+ for Switches ("proc.adb")
-+ use ("-O0");
- end Compiler;
- @end smallexample
-
- @noindent
-- @code{^Switches^Switches^} may take a pattern as an index, such as in:
-+ @code{Switches} may take a pattern as an index, such as in:
-
- @smallexample
- package Compiler is
- for Default_Switches ("Ada")
-- use ("^-O2^-O2^");
-- for ^Switches^Switches^ ("pkg*")
-- use ("^-O0^-O0^");
-+ use ("-O2");
-+ for Switches ("pkg*")
-+ use ("-O0");
- end Compiler;
- @end smallexample
-
- @noindent
-- Sources @file{pkg.adb} and @file{pkg-child.adb} would be compiled with ^-O0^-O0^,
-- not ^-O2^-O2^.
-+ Sources @file{pkg.adb} and @file{pkg-child.adb} would be compiled with -O0,
-+ not -O2.
-
- @noindent
-- @code{^Switches^Switches^} can also be given a language name as index instead of a file
-+ @code{Switches} can also be given a language name as index instead of a file
- name in which case it has the same semantics as @emph{Default_Switches}.
- However, indexes with wild cards are never valid for language name.
-
-@@ -696,7 +693,7 @@ Several attributes can be used to specify the ^switches^switches^:
- @end table
-
- The switches for the other tools are defined in a similar manner through the
-- at b{Default_Switches} and @b{^Switches^Switches^} attributes, respectively in the
-+ at b{Default_Switches} and @b{Switches} attributes, respectively in the
- @emph{Builder} package (for @command{gnatmake} and @command{gprbuild}),
- the @emph{Binder} package (binding Ada executables) and the @emph{Linker}
- package (for linking executables).
-@@ -711,7 +708,7 @@ Now that our project files are written, let's build our executable.
- Here is the command we would use from the command line:
-
- @smallexample
-- gnatmake ^-Pbuild^/PROJECT_FILE=build^
-+ gnatmake -Pbuild
- @end smallexample
-
- @noindent
-@@ -727,7 +724,7 @@ same way: create the file @file{utils.c} in the @file{common} directory,
- set the attribute @emph{Languages} to @code{"(Ada, C)"}, and run
-
- @smallexample
-- gprbuild ^-Pbuild^/PROJECT_FILE=build^
-+ gprbuild -Pbuild
- @end smallexample
-
- @noindent
-@@ -784,19 +781,19 @@ on Windows), we could configure our project file to build "proc1"
- (resp proc1.exe) with the following addition:
-
- @smallexample @c projectfile
-- project Build is
-- ... -- same as before
-- package Builder is
-- for Executable ("proc.adb") use "proc1";
-- end Builder
-- end Build;
-+ @b{project} Build @b{is}
-+ ... -- at i{ same as before}
-+ @b{package} Builder @b{is}
-+ @b{for} Executable ("proc.adb") @b{use} "proc1";
-+ @b{end} Builder
-+ @b{end} Build;
- @end smallexample
-
- @noindent
- @cindex @code{Executable_Suffix}
- Attribute @b{Executable_Suffix}, when specified, may change the suffix
- of the executable files, when no attribute @code{Executable} applies:
--its value replace the platform-specific executable suffix.
-+its value replaces the platform-specific executable suffix.
- The default executable suffix is empty on UNIX and ".exe" on Windows.
-
- It is also possible to change the name of the produced executable by using the
-@@ -815,18 +812,18 @@ To illustrate some other project capabilities, here is a slightly more complex
- project using similar sources and a main program in C:
-
- @smallexample @c projectfile
--project C_Main is
-- for Languages use ("Ada", "C");
-- for Source_Dirs use ("common");
-- for Object_Dir use "obj";
-- for Main use ("main.c");
-- package Compiler is
-+ at b{project} C_Main @b{is}
-+ @b{for} Languages @b{use} ("Ada", "C");
-+ @b{for} Source_Dirs @b{use} ("common");
-+ @b{for} Object_Dir @b{use} "obj";
-+ @b{for} Main @b{use} ("main.c");
-+ @b{package} Compiler @b{is}
- C_Switches := ("-pedantic");
-- for Default_Switches ("C") use C_Switches;
-- for Default_Switches ("Ada") use ("^-gnaty^-gnaty^");
-- for ^Switches^Switches^ ("main.c") use C_Switches & ("-g");
-- end Compiler;
--end C_Main;
-+ @b{for} Default_Switches ("C") @b{use} C_Switches;
-+ @b{for} Default_Switches ("Ada") @b{use} ("-gnaty");
-+ @b{for} Switches ("main.c") @b{use} C_Switches & ("-g");
-+ @b{end} Compiler;
-+ at b{end} C_Main;
- @end smallexample
-
- @noindent
-@@ -848,7 +845,7 @@ In this specific situation the use of a variable could have been
- replaced by a reference to the @code{Default_Switches} attribute:
-
- @smallexample @c projectfile
-- for ^Switches^Switches^ ("c_main.c") use Compiler'Default_Switches ("C") & ("-g");
-+ @b{for} Switches ("c_main.c") @b{use} Compiler'Default_Switches ("C") & ("-g");
- @end smallexample
-
- @noindent
-@@ -940,7 +937,7 @@ The following attributes can be defined in package @code{Naming}:
- @code{Specification_Exceptions}.
-
- If @code{Spec_Suffix ("Ada")} is not specified, then the default is
-- @code{"^.ads^.ADS^"}.
-+ @code{".ads"}.
-
- A non empty value must satisfy the following requirements:
-
-@@ -969,7 +966,7 @@ The following attributes can be defined in package @code{Naming}:
- In addition, they must be different from any of the values in
- @code{Spec_Suffix}.
- If @code{Body_Suffix ("Ada")} is not specified, then the default is
-- @code{"^.adb^.ADB^"}.
-+ @code{".adb"}.
-
- If @code{Body_Suffix ("Ada")} and @code{Spec_Suffix ("Ada")} end with the
- same string, then a file name that ends with the longest of these two
-@@ -1029,39 +1026,20 @@ The following attributes can be defined in package @code{Naming}:
-
- @end table
-
-- at ifclear vms
-+ at set unw
- For example, the following package models the Apex file naming rules:
-
- @smallexample @c projectfile
- @group
-- package Naming is
-- for Casing use "lowercase";
-- for Dot_Replacement use ".";
-- for Spec_Suffix ("Ada") use ".1.ada";
-- for Body_Suffix ("Ada") use ".2.ada";
-- end Naming;
-+ @b{package} Naming @b{is}
-+ @b{for} Casing @b{use} "lowercase";
-+ @b{for} Dot_Replacement @b{use} ".";
-+ @b{for} Spec_Suffix ("Ada") @b{use} ".1.ada";
-+ @b{for} Body_Suffix ("Ada") @b{use} ".2.ada";
-+ @b{end} Naming;
- @end group
- @end smallexample
-- at end ifclear
-
-- at ifset vms
--For example, the following package models the DEC Ada file naming rules:
--
-- at smallexample @c projectfile
-- at group
-- package Naming is
-- for Casing use "lowercase";
-- for Dot_Replacement use "__";
-- for Spec_Suffix ("Ada") use "_.ada";
-- for Body_Suffix ("Ada") use ".ada";
-- end Naming;
-- at end group
-- at end smallexample
--
-- at noindent
--(Note that @code{Casing} is @code{"lowercase"} because GNAT gets the file
--names in lower case)
-- at end ifset
-
- @c ---------------------------------------------
- @node Installation
-@@ -1117,6 +1095,16 @@ installed. Default is @b{include}.
-
- Subdirectory of @b{Prefix} where the generated project file is to be
- installed. Default is @b{share/gpr}.
-+
-+ at item @b{Mode}
-+
-+The installation mode, it is either @b{dev} (default) or @b{usage}.
-+See @b{gprbuild} user's guide for details.
-+
-+ at item @b{Install_Name}
-+
-+Specify the name to use for recording the installation. The default is
-+the project name without the extension.
- @end table
-
- @c ---------------------------------------------
-@@ -1182,29 +1170,29 @@ so far in @file{build.gpr}, building the application would fail with an error
- indicating that the gtkada and logging units that are relied upon by the sources
- of this project cannot be found.
-
--This is easily solved by adding the following @b{with} clauses at the beginning
--of our project:
-+This is solved by adding the following @b{with} clauses at the beginning of our
-+project:
-
- @smallexample @c projectfile
-- with "gtkada.gpr";
-- with "a/b/logging.gpr";
-- project Build is
-- ... -- as before
-- end Build;
-+ @b{with} "gtkada.gpr";
-+ @b{with} "a/b/logging.gpr";
-+ @b{project} Build @b{is}
-+ ... -- at i{ as before}
-+ @b{end} Build;
- @end smallexample
-
- @noindent
- @cindex @code{Externally_Built}
--When such a project is compiled, @command{gnatmake} will automatically
--check the other projects and recompile their sources when needed. It will also
-+When such a project is compiled, @command{gprbuild} will automatically check
-+the other projects and recompile their sources when needed. It will also
- recompile the sources from @code{Build} when needed, and finally create the
- executable. In some cases, the implementation units needed to recompile a
--project are not available, or come from some third-party and you do not want to
--recompile it yourself. In this case, the attribute @b{Externally_Built} to
--"true" can be set, indicating to the builder that this project can be assumed
--to be up-to-date, and should not be considered for recompilation. In Ada, if
--the sources of this externally built project were compiled with another version
--of the compiler or with incompatible options, the binder will issue an error.
-+project are not available, or come from some third party and you do not want to
-+recompile it yourself. In this case, set the attribute @b{Externally_Built} to
-+"true", indicating to the builder that this project can be assumed to be
-+up-to-date, and should not be considered for recompilation. In Ada, if the
-+sources of this externally built project were compiled with another version of
-+the compiler or with incompatible options, the binder will issue an error.
-
- The project's @code{with} clause has several effects. It provides source
- visibility between projects during the compilation process. It also guarantees
-@@ -1219,7 +1207,7 @@ project files rather than packages.
- Each literal string after @code{with} is the path
- (absolute or relative) to a project file. The @code{.gpr} extension is
- optional, although we recommend adding it. If no extension is specified,
--and no project file with the @file{^.gpr^.GPR^} extension is found, then
-+and no project file with the @file{.gpr} extension is found, then
- the file is searched for exactly as written in the @code{with} clause,
- that is with no extension.
-
-@@ -1233,8 +1221,7 @@ A solution if you need something like this is to use aggregate projects
- When a relative path or a base name is used, the
- project files are searched relative to each of the directories in the
- @b{project path}. This path includes all the directories found with the
--following algorithm, in that order, as soon as a matching file is found,
--the search stops:
-+following algorithm, in this order; the first matching file is used:
-
- @itemize @bullet
- @item First, the file is searched relative to the directory that contains the
-@@ -1245,7 +1232,7 @@ the search stops:
- @cindex @code{GPR_PROJECT_PATH}
- @cindex @code{ADA_PROJECT_PATH}
- Then it is searched relative to all the directories specified in the
-- ^environment variables^logical names^ @b{GPR_PROJECT_PATH_FILE},
-+ environment variables @b{GPR_PROJECT_PATH_FILE},
- @b{GPR_PROJECT_PATH} and @b{ADA_PROJECT_PATH} (in that order) if they exist.
- The value of @b{GPR_PROJECT_PATH_FILE}, when defined, is the path name of
- a text file that contains project directory path names, one per line.
-@@ -1255,8 +1242,8 @@ the search stops:
- use @b{GPR_PROJECT_PATH_FILE} or @b{GPR_PROJECT_PATH}.
-
- @item Finally, it is searched relative to the default project directories.
-- Such directories depends on the tool used. The different locations searched
-- in the specified order are:
-+ Such directories depend on the tool used. The locations searched in the
-+ specified order are:
-
- @itemize @bullet
- @item @file{<prefix>/<target>/lib/gnat}
-@@ -1371,11 +1358,11 @@ There are two main approaches to avoiding this duplication:
- @smallexample @c projectfile
- project Logging is
- package Compiler is
-- for ^Switches^Switches^ ("Ada")
-- use ("^-O2^-O2^");
-+ for Switches ("Ada")
-+ use ("-O2");
- end Compiler;
- package Binder is
-- for ^Switches^Switches^ ("Ada")
-+ for Switches ("Ada")
- use ("-E");
- end Binder;
- end Logging;
-@@ -1384,7 +1371,7 @@ There are two main approaches to avoiding this duplication:
- project Build is
- package Compiler renames Logging.Compiler;
- package Binder is
-- for ^Switches^Switches^ ("Ada") use Logging.Binder'Switches ("Ada");
-+ for Switches ("Ada") use Logging.Binder'Switches ("Ada");
- end Binder;
- end Build;
- @end smallexample
-@@ -1407,7 +1394,7 @@ There are two main approaches to avoiding this duplication:
- @end smallexample
-
- @item The second approach is to define the switches in a third project.
-- That project is setup without any sources (so that, as opposed to
-+ That project is set up without any sources (so that, as opposed to
- the first example, none of the project plays a special role), and
- will only be used to define the attributes. Such a project is
- typically called @file{shared.gpr}.
-@@ -1416,8 +1403,8 @@ There are two main approaches to avoiding this duplication:
- abstract project Shared is
- for Source_Files use (); -- no sources
- package Compiler is
-- for ^Switches^Switches^ ("Ada")
-- use ("^-O2^-O2^");
-+ for Switches ("Ada")
-+ use ("-O2");
- end Compiler;
- end Shared;
-
-@@ -1499,21 +1486,21 @@ Various aspects of the projects can be modified based on @b{scenarios}. These
- are user-defined modes that change the behavior of a project. Typical
- examples are the setup of platform-specific compiler options, or the use of
- a debug and a release mode (the former would activate the generation of debug
--information, when the second will focus on improving code optimization).
-+information, while the second will focus on improving code optimization).
-
--Let's enhance our example to support a debug and a release modes.The issue is to
--let the user choose what kind of system he is building:
--use @option{-g} as compiler switches in debug mode and @option{^-O2^-O2^}
--in release mode. We will also setup the projects so that we do not share the
--same object directory in both modes, otherwise switching from one to the other
--might trigger more recompilations than needed or mix objects from the 2 modes.
-+Let's enhance our example to support debug and release modes. The issue is to
-+let the user choose what kind of system he is building: use @option{-g} as
-+compiler switches in debug mode and @option{-O2} in release mode. We will also
-+set up the projects so that we do not share the same object directory in both
-+modes; otherwise switching from one to the other might trigger more
-+recompilations than needed or mix objects from the two modes.
-
- One naive approach is to create two different project files, say
- @file{build_debug.gpr} and @file{build_release.gpr}, that set the appropriate
--attributes as explained in previous sections. This solution does not scale well,
--because in presence of multiple projects depending on each other,
--you will also have to duplicate the complete hierarchy and adapt the project
--files to point to the right copies.
-+attributes as explained in previous sections. This solution does not scale
-+well, because in the presence of multiple projects depending on each other, you
-+will also have to duplicate the complete hierarchy and adapt the project files
-+to point to the right copies.
-
- @cindex scenarios
- Instead, project files support the notion of scenarios controlled
-@@ -1532,27 +1519,27 @@ order of priority):
- or gnatmake -Pbuild.gpr -Xmode=release
- @end smallexample
-
-- at item @b{^Environment variables^Logical names^}:
-+ at item @b{Environment variables}:
- When the external value does not come from the command line, it can come from
-- the value of ^environment variables^logical names^ of the appropriate name.
-- In our case, if ^an environment variable^a logical name^ called "mode"
-- exist, its value will be taken into account.
-+ the value of environment variables of the appropriate name.
-+ In our case, if an environment variable called "mode"
-+ exists, its value will be taken into account.
-
-- at item @b{External function second parameter}
-+ at item @b{External function second parameter}.
-
- @end table
-
- @cindex @code{external}
- We now need to get that value in the project. The general form is to use
- the predefined function @b{external} which returns the current value of
--the external. For instance, we could setup the object directory to point to
-+the external. For instance, we could set up the object directory to point to
- either @file{obj/debug} or @file{obj/release} by changing our project to
-
- @smallexample @c projectfile
-- project Build is
-- for Object_Dir use "obj/" & external ("mode", "debug");
-- ... -- as before
-- end Build;
-+ @b{project} Build @b{is}
-+ @b{for} Object_Dir @b{use} "obj/" & @b{external} ("mode", "debug");
-+ ... -- at i{ as before}
-+ @b{end} Build;
- @end smallexample
-
- @noindent
-@@ -1570,21 +1557,21 @@ Such a variable can then be used in a @b{case construction} and create condition
- sections in the project. The following example shows how this can be done:
-
- @smallexample @c projectfile
-- project Build is
-- type Mode_Type is ("debug", "release"); -- all possible values
-- Mode : Mode_Type := external ("mode", "debug"); -- a typed variable
--
-- package Compiler is
-- case Mode is
-- when "debug" =>
-- for ^Switches^Switches^ ("Ada")
-- use ("-g");
-- when "release" =>
-- for ^Switches^Switches^ ("Ada")
-- use ("^-O2^-O2^");
-- end case;
-- end Compiler;
-- end Build;
-+ @b{project} Build @b{is}
-+ @b{type} Mode_Type @b{is} ("debug", "release"); -- at i{ all possible values}
-+ Mode : Mode_Type := @b{external} ("mode", "debug"); -- at i{ a typed variable}
-+
-+ @b{package} Compiler @b{is}
-+ @b{case} Mode @b{is}
-+ @b{when} "debug" =>
-+ @b{for} Switches ("Ada")
-+ @b{use} ("-g");
-+ @b{when} "release" =>
-+ @b{for} Switches ("Ada")
-+ @b{use} ("-O2");
-+ @b{end} @b{case};
-+ @b{end} Compiler;
-+ @b{end} Build;
- @end smallexample
-
- @noindent
-@@ -1599,7 +1586,7 @@ force the user to define the value. Finally, we can use a case construction to s
- switches depending on the scenario the user has chosen.
-
- Most aspects of the projects can depend on scenarios. The notable exception
--are project dependencies (@code{with} clauses), which may not depend on a scenario.
-+are project dependencies (@code{with} clauses), which cannot depend on a scenario.
-
- Scenarios work the same way with @b{project hierarchies}: you can either
- duplicate a variable similar to @code{Mode} in each of the project (as long
-@@ -1620,7 +1607,7 @@ using system-specific means such as archives or windows DLLs.
-
- Library projects provide a system- and language-independent way of building both @b{static}
- and @b{dynamic} libraries. They also support the concept of @b{standalone
--libraries} (SAL) which offers two significant properties: the elaboration
-+libraries} (SAL) which offer two significant properties: the elaboration
- (e.g. initialization) of the library is either automatic or very simple;
- a change in the
- implementation part of the library implies minimal post-compilation actions on
-@@ -1651,12 +1638,12 @@ installation of the library (i.e., copying associated source, object and
-
- @noindent
- Let's enhance our example and transform the @code{logging} subsystem into a
--library. In order to do so, a few changes need to be made to @file{logging.gpr}.
--A number of specific attributes needs to be defined: at least @code{Library_Name}
--and @code{Library_Dir}; in addition, a number of other attributes can be used
--to specify specific aspects of the library. For readability, it is also
--recommended (although not mandatory), to use the qualifier @code{library} in
--front of the @code{project} keyword.
-+library. In order to do so, a few changes need to be made to
-+ at file{logging.gpr}. Some attributes need to be defined: at least
-+ at code{Library_Name} and @code{Library_Dir}; in addition, some other attributes
-+can be used to specify specific aspects of the library. For readability, it is
-+also recommended (although not mandatory), to use the qualifier @code{library}
-+in front of the @code{project} keyword.
-
- @table @asis
- @item @b{Library_Name}:
-@@ -1664,7 +1651,7 @@ front of the @code{project} keyword.
- This attribute is the name of the library to be built. There is no
- restriction on the name of a library imposed by the project manager, except
- for stand-alone libraries whose names must follow the syntax of Ada
-- identifiers; however, there may be system specific restrictions on the name.
-+ identifiers; however, there may be system-specific restrictions on the name.
- In general, it is recommended to stick to alphanumeric characters (and
- possibly single underscores) to help portability.
-
-@@ -1675,7 +1662,7 @@ front of the @code{project} keyword.
- the sources are compiled, the object files end up in the explicit or
- implicit @code{Object_Dir} directory. When all sources of a library
- are compiled, some of the compilation artifacts, including the library itself,
-- are copied to the library_dir directory. This directory must exists and be
-+ are copied to the library_dir directory. This directory must exist and be
- writable. It must also be different from the object directory so that cleanup
- activities in the Library_Dir do not affect recompilation needs.
-
-@@ -1684,11 +1671,11 @@ front of the @code{project} keyword.
- Here is the new version of @file{logging.gpr} that makes it a library:
-
- @smallexample @c projectfile
--library project Logging is -- "library" is optional
-- for Library_Name use "logging"; -- will create "liblogging.a" on Unix
-- for Object_Dir use "obj";
-- for Library_Dir use "lib"; -- different from object_dir
--end Logging;
-+library @b{project} Logging @b{is} -- at i{ "library" is optional}
-+ @b{for} Library_Name @b{use} "logging"; -- at i{ will create "liblogging.a" on Unix}
-+ @b{for} Object_Dir @b{use} "obj";
-+ @b{for} Library_Dir @b{use} "lib"; -- at i{ different from object_dir}
-+ at b{end} Logging;
- @end smallexample
-
- @noindent
-@@ -1713,11 +1700,10 @@ Other library-related attributes can be used to change the defaults:
- a library on different operating systems.
-
- If you need to build both a static and a dynamic library, it is recommended
-- use two different object directories, since in some cases some extra code
-- needs to be generated for the latter. For such cases, one can
-- either define two different project files, or a single one which uses scenarios
-- to indicate the various kinds of library to be built and their
-- corresponding object_dir.
-+ to use two different object directories, since in some cases some extra code
-+ needs to be generated for the latter. For such cases, one can either define
-+ two different project files, or a single one that uses scenarios to indicate
-+ the various kinds of library to be built and their corresponding object_dir.
-
- @cindex @code{Library_ALI_Dir}
- @item @b{Library_ALI_Dir}:
-@@ -1730,7 +1716,7 @@ Other library-related attributes can be used to change the defaults:
-
- @cindex @code{Library_Version}
- @item @b{Library_Version}:
-- This attribute is platform dependent, and has no effect on VMS and Windows.
-+ This attribute is platform dependent, and has no effect on Windows.
- On Unix, it is used only for dynamic libraries as the internal
- name of the library (the @code{"soname"}). If the library file name (built
- from the @code{Library_Name}) is different from the @code{Library_Version},
-@@ -1740,13 +1726,13 @@ Other library-related attributes can be used to change the defaults:
-
- @smallexample @c projectfile
- @group
-- project Logging is
-+ @b{project} Logging @b{is}
- Version := "1";
-- for Library_Dir use "lib";
-- for Library_Name use "logging";
-- for Library_Kind use "dynamic";
-- for Library_Version use "liblogging.so." & Version;
-- end Logging;
-+ @b{for} Library_Dir @b{use} "lib";
-+ @b{for} Library_Name @b{use} "logging";
-+ @b{for} Library_Kind @b{use} "dynamic";
-+ @b{for} Library_Version @b{use} "liblogging.so." & Version;
-+ @b{end} Logging;
- @end group
- @end smallexample
-
-@@ -1759,7 +1745,7 @@ Other library-related attributes can be used to change the defaults:
- @item @b{Library_GCC}:
- This attribute is the name of the tool to use instead of "gcc" to link shared
- libraries. A common use of this attribute is to define a wrapper script that
-- accomplishes specific actions before calling gcc (which itself is calling the
-+ accomplishes specific actions before calling gcc (which itself calls the
- linker to build the library image).
-
- @item @b{Library_Options}:
-@@ -1767,6 +1753,10 @@ Other library-related attributes can be used to change the defaults:
- This attribute may be used to specify additional switches (last switches)
- when linking a shared library.
-
-+ It may also be used to add foreign object files to a static library.
-+ Each string in Library_Options is an absolute or relative path of an object
-+ file. When a relative path, it is relative to the object directory.
-+
- @item @b{Leading_Library_Options}:
- @cindex @code{Leading_Library_Options}
- This attribute, that is taken into account only by @command{gprbuild}, may be
-@@ -1812,11 +1802,10 @@ corresponding to the sources of the project.
-
- A non-library project can import a library project. When the builder is invoked
- on the former, the library of the latter is only rebuilt when absolutely
--necessary. For instance, if a unit of the
--library is not up-to-date but non of the executables need this unit, then the
--unit is not recompiled and the library is not reassembled.
--For instance, let's assume in our example that logging has the following
--sources: @file{log1.ads}, @file{log1.adb}, @file{log2.ads} and
-+necessary. For instance, if a unit of the library is not up-to-date but none of
-+the executables need this unit, then the unit is not recompiled and the library
-+is not reassembled. For instance, let's assume in our example that logging has
-+the following sources: @file{log1.ads}, @file{log1.adb}, @file{log2.ads} and
- @file{log2.adb}. If @file{log1.adb} has been modified, then the library
- @file{liblogging} will be rebuilt when compiling all the sources of
- @code{Build} only if @file{proc.ads}, @file{pack.ads} or @file{pack.adb}
-@@ -1824,7 +1813,7 @@ include a @code{"with Log1"}.
-
- To ensure that all the sources in the @code{Logging} library are
- up to date, and that all the sources of @code{Build} are also up to date,
--the following two commands needs to be used:
-+the following two commands need to be used:
-
- @smallexample
- gnatmake -Plogging.gpr
-@@ -1836,21 +1825,20 @@ All @file{ALI} files will also be copied from the object directory to the
- library directory. To build executables, @command{gnatmake} will use the
- library rather than the individual object files.
-
-- at ifclear vms
--Library projects can also be useful to describe a library that need to be used
-+Library projects can also be useful to describe a library that needs to be used
- but, for some reason, cannot be rebuilt. For instance, it is the case when some
--of the library sources are not available. Such library projects need simply to
--use the @code{Externally_Built} attribute as in the example below:
-+of the library sources are not available. Such library projects need to use the
-+ at code{Externally_Built} attribute as in the example below:
-
- @smallexample @c projectfile
--library project Extern_Lib is
-- for Languages use ("Ada", "C");
-- for Source_Dirs use ("lib_src");
-- for Library_Dir use "lib2";
-- for Library_Kind use "dynamic";
-- for Library_Name use "l2";
-- for Externally_Built use "true"; -- <<<<
--end Extern_Lib;
-+library @b{project} Extern_Lib @b{is}
-+ @b{for} Languages @b{use} ("Ada", "C");
-+ @b{for} Source_Dirs @b{use} ("lib_src");
-+ @b{for} Library_Dir @b{use} "lib2";
-+ @b{for} Library_Kind @b{use} "dynamic";
-+ @b{for} Library_Name @b{use} "l2";
-+ @b{for} Externally_Built @b{use} "true"; -- at i{ <<<<}
-+ at b{end} Extern_Lib;
- @end smallexample
-
- @noindent
-@@ -1870,7 +1858,6 @@ In such a situation, it is better to use the externally built library project
- so that all other subsystems depending on it can declare this dependency thanks
- to a project @code{with} clause, which in turn will trigger the builder to find
- the proper order of libraries in the final link command.
-- at end ifclear
-
- @c ---------------------------------------------
- @node Stand-alone Library Projects
-@@ -1910,9 +1897,9 @@ language and takes a list of sources as parameter.
-
- @smallexample @c projectfile
- @group
-- for Library_Dir use "lib";
-- for Library_Name use "loggin";
-- for Library_Interface use ("lib1", "lib2"); -- unit names
-+ @b{for} Library_Dir @b{use} "lib";
-+ @b{for} Library_Name @b{use} "logging";
-+ @b{for} Library_Interface @b{use} ("lib1", "lib2"); -- at i{ unit names}
- @end group
- @end smallexample
-
-@@ -1931,7 +1918,7 @@ language and takes a list of sources as parameter.
- build. Values are either @code{standard} (the default), @code{no} or
- @code{encapsulated}. When @code{standard} is used the code to elaborate and
- finalize the library is embedded, when @code{encapsulated} is used the
-- library can furthermore only depends on static libraries (including
-+ library can furthermore depend only on static libraries (including
- the GNAT runtime). This attribute can be set to @code{no} to make it clear
- that the library should not be standalone in which case the
- @code{Library_Interface} should not defined. Note that this attribute
-@@ -1940,11 +1927,11 @@ language and takes a list of sources as parameter.
-
- @smallexample @c projectfile
- @group
-- for Library_Dir use "lib";
-- for Library_Name use "loggin";
-- for Library_Kind use "dynamic";
-- for Library_Interface use ("lib1", "lib2"); -- unit names
-- for Library_Standalone use "encapsulated";
-+ @b{for} Library_Dir @b{use} "lib";
-+ @b{for} Library_Name @b{use} "logging";
-+ @b{for} Library_Kind @b{use} "dynamic";
-+ @b{for} Library_Interface @b{use} ("lib1", "lib2"); -- at i{ unit names}
-+ @b{for} Library_Standalone @b{use} "encapsulated";
- @end group
- @end smallexample
-
-@@ -1952,7 +1939,7 @@ language and takes a list of sources as parameter.
-
- In order to include the elaboration code in the stand-alone library, the binder
- is invoked on the closure of the library units creating a package whose name
--depends on the library name (^b~logging.ads/b^B$LOGGING.ADS/B^ in the example).
-+depends on the library name (b~logging.ads/b in the example).
- This binder-generated package includes @b{initialization} and @b{finalization}
- procedures whose names depend on the library name (@code{logginginit} and
- @code{loggingfinal} in the example). The object corresponding to this package is
-@@ -1966,7 +1953,7 @@ included in the library.
- platform and if attribute @b{Library_Auto_Init} is not specified or
- is specified with the value "true". A static Stand-alone Library is never
- automatically initialized. Specifying "false" for this attribute
-- prevent automatic initialization.
-+ prevents automatic initialization.
-
- When a non-automatically initialized stand-alone library is used in an
- executable, its initialization procedure must be called before any service of
-@@ -1992,11 +1979,11 @@ included in the library.
- This attribute defines the location (absolute or relative to the project
- directory) where the sources of the interface units are copied at
- installation time.
-- These sources includes the specs of the interface units along with the closure
-- of sources necessary to compile them successfully. That may include bodies and
-- subunits, when pragmas @code{Inline} are used, or when there is a generic
-- units in the spec. This directory cannot point to the object directory or
-- one of the source directories, but it can point to the library directory,
-+ These sources includes the specs of the interface units along with the
-+ closure of sources necessary to compile them successfully. That may include
-+ bodies and subunits, when pragmas @code{Inline} are used, or when there are
-+ generic units in specs. This directory cannot point to the object directory
-+ or one of the source directories, but it can point to the library directory,
- which is the default value for this attribute.
-
- @item @b{Library_Symbol_Policy}:
-@@ -2066,9 +2053,9 @@ a project file slightly different from the one used to build the library, by
- using the @code{externally_built} attribute. @ref{Using Library Projects}
-
- Another option is to use @command{gprinstall} to install the library in a
--different context than the build location. A project to use this library is
--generated automatically by @command{gprinstall} which also copy, in the install
--location, the minimum set of sources needed to use the library.
-+different context than the build location. @command{gprinstall} automatically
-+generates a project to use this library, and also copies the minimum set of
-+sources needed to use the library to the install location.
- @ref{Installation}
-
- @c ---------------------------------------------
-@@ -2082,7 +2069,7 @@ modified versions of some of the source files, without changing the original
- sources. This can be achieved through the @b{project extension} facility.
-
- Suppose for instance that our example @code{Build} project is built every night
--for the whole team, in some shared directory. A developer usually need to work
-+for the whole team, in some shared directory. A developer usually needs to work
- on a small part of the system, and might not want to have a copy of all the
- sources and all the object files (mostly because that would require too much
- disk space, time to recompile everything). He prefers to be able to override
-@@ -2092,7 +2079,7 @@ object files generated at night.
- Another example can be taken from large software systems, where it is common to have
- multiple implementations of a common interface; in Ada terms, multiple
- versions of a package body for the same spec. For example, one implementation
--might be safe for use in tasking programs, while another might only be used
-+might be safe for use in tasking programs, while another might be used only
- in sequential applications. This can be modeled in GNAT using the concept
- of @emph{project extension}. If one project (the ``child'') @emph{extends}
- another project (the ``parent'') then by default all source files of the
-@@ -2113,28 +2100,28 @@ Project extensions provide a flexible solution to create a new version
- of a subsystem while sharing and reusing as much as possible from the original
- one.
-
--A project extension inherits implicitly all the sources and objects from the
-+A project extension implicitly inherits all the sources and objects from the
- project it extends. It is possible to create a new version of some of the
--sources in one of the additional source dirs of the extending project. Those new
--versions hide the original versions. Adding new sources or removing existing
--ones is also possible. Here is an example on how to extend the project
-- at code{Build} from previous examples:
-+sources in one of the additional source directories of the extending
-+project. Those new versions hide the original versions. Adding new sources or
-+removing existing ones is also possible. Here is an example on how to extend
-+the project @code{Build} from previous examples:
-
- @smallexample @c projectfile
-- project Work extends "../bld/build.gpr" is
-- end Work;
-+ @b{project} Work @b{extends} "../bld/build.gpr" @b{is}
-+ @b{end} Work;
- @end smallexample
-
- @noindent
- The project after @b{extends} is the one being extended. As usual, it can be
- specified using an absolute path, or a path relative to any of the directories
- in the project path (@pxref{Project Dependencies}). This project does not
--specify source or object directories, so the default value for these attribute
--will be used that is to say the current directory (where project @code{Work} is
--placed). We can already compile that project with
-+specify source or object directories, so the default values for these
-+attributes will be used that is to say the current directory (where project
-+ at code{Work} is placed). We can compile that project with
-
- @smallexample
-- gnatmake -Pwork
-+ gprbuild -Pwork
- @end smallexample
-
- @noindent
-@@ -2144,14 +2131,14 @@ sources it inherited from @code{Build}, therefore all the object files
- in @code{Build} and its dependencies are still valid and are reused
- automatically.
-
--Suppose we now want to supply an alternate version of @file{pack.adb}
--but use the existing versions of @file{pack.ads} and @file{proc.adb}.
--We can create the new file Work's current directory (likely
--by copying the one from the @code{Build} project and making changes to
--it. If new packages are needed at the same time, we simply create
--new files in the source directory of the extending project.
-+Suppose we now want to supply an alternate version of @file{pack.adb} but use
-+the existing versions of @file{pack.ads} and @file{proc.adb}. We can create
-+the new file in Work's current directory (likely by copying the one from the
-+ at code{Build} project and making changes to it. If new packages are needed at
-+the same time, we simply create new files in the source directory of the
-+extending project.
-
--When we recompile, @command{gnatmake} will now automatically recompile
-+When we recompile, @command{gprbuild} will now automatically recompile
- this file (thus creating @file{pack.o} in the current directory) and
- any file that depends on it (thus creating @file{proc.o}). Finally, the
- executable is also linked locally.
-@@ -2200,7 +2187,7 @@ extended.
- At the project level, if they are not declared in the extending project, some
- attributes are inherited from the project being extended. They are:
- @code{Languages}, @code{Main} (for a root non library project) and
-- at code{Library_Name} (for a project extending a library project)
-+ at code{Library_Name} (for a project extending a library project).
-
- @menu
- * Project Hierarchy Extension::
-@@ -2236,18 +2223,18 @@ create several extending projects:
-
- @noindent
- @smallexample @c projectfile
-- project A_Ext extends "a.gpr" is
-- for Source_Files use ("a1.adb", "a1.ads");
-- end A_Ext;
--
-- with "a_ext.gpr";
-- project B_Ext extends "b.gpr" is
-- end B_Ext;
--
-- with "b_ext.gpr";
-- project C_Ext extends "c.gpr" is
-- for Source_Files use ("c1.adb");
-- end C_Ext;
-+ @b{project} A_Ext @b{extends} "a.gpr" @b{is}
-+ @b{for} Source_Files @b{use} ("a1.adb", "a1.ads");
-+ @b{end} A_Ext;
-+
-+ @b{with} "a_ext.gpr";
-+ @b{project} B_Ext @b{extends} "b.gpr" @b{is}
-+ @b{end} B_Ext;
-+
-+ @b{with} "b_ext.gpr";
-+ @b{project} C_Ext @b{extends} "c.gpr" @b{is}
-+ @b{for} Source_Files @b{use} ("c1.adb");
-+ @b{end} C_Ext;
- @end smallexample
-
- @noindent
-@@ -2259,7 +2246,7 @@ import @file{b.gpr} which itself knows nothing about @file{a_ext.gpr}.
- When extending a large system spanning multiple projects, it is often
- inconvenient to extend every project in the hierarchy that is impacted by a
- small change introduced in a low layer. In such cases, it is possible to create
--an @b{implicit extension} of entire hierarchy using @b{extends all}
-+an @b{implicit extension} of an entire hierarchy using @b{extends all}
- relationship.
-
- When the project is extended using @code{extends all} inheritance, all projects
-@@ -2276,7 +2263,7 @@ projects with the explicit ones.
-
- When building such a project hierarchy extension, the project manager will
- ensure that both modified sources and sources in implicit extending projects
--that depend on them, are recompiled.
-+that depend on them are recompiled.
-
- Thus, in our example we could create the following projects instead:
-
-@@ -2288,14 +2275,14 @@ Thus, in our example we could create the following projects instead:
-
- @noindent
- @smallexample @c projectfile
-- project A_Ext extends "a.gpr" is
-- for Source_Files use ("a1.adb", "a1.ads");
-- end A_Ext;
--
-- with "a_ext.gpr";
-- project C_Ext extends all "c.gpr" is
-- for Source_Files use ("c1.adb");
-- end C_Ext;
-+ @b{project} A_Ext @b{extends} "a.gpr" @b{is}
-+ @b{for} Source_Files @b{use} ("a1.adb", "a1.ads");
-+ @b{end} A_Ext;
-+
-+ @b{with} "a_ext.gpr";
-+ @b{project} C_Ext @b{extends} @b{all} "c.gpr" @b{is}
-+ @b{for} Source_Files @b{use} ("c1.adb");
-+ @b{end} C_Ext;
- @end smallexample
-
- @noindent
-@@ -2365,9 +2352,9 @@ and C. Then, when you build with
- this will build all mains from A, B and C.
-
- @smallexample @c projectfile
-- aggregate project Agg is
-- for Project_Files use ("a.gpr", "b.gpr", "c.gpr");
-- end Agg;
-+ aggregate @b{project} Agg @b{is}
-+ @b{for} Project_Files @b{use} ("a.gpr", "b.gpr", "c.gpr");
-+ @b{end} Agg;
- @end smallexample
-
- If B or C do not define any main program (through their Main
-@@ -2380,7 +2367,7 @@ aggregate project, you will need to add "p.gpr" in the list of project
- files for the aggregate project, or the main will not be built when
- building the aggregate project.
-
--Aggregate projects are only supported with @command{gprbuild}, but not with
-+Aggregate projects are supported only with @command{gprbuild}, not with
- @command{gnatmake}.
-
- @c ---------------------------------------------------------
-@@ -2426,7 +2413,7 @@ The environment variables at the time you launch @command{gprbuild}
- will influence the view these tools have of the project
- (PATH to find the compiler, ADA_PROJECT_PATH or GPR_PROJECT_PATH to find the
- projects, environment variables that are referenced in project files
--through the "external" statement,...). Several command line switches
-+through the "external" built-in function, ...). Several command line switches
- can be used to override those (-X or -aP), but on some systems and
- with some projects, this might make the command line too long, and on
- all systems often make it hard to read.
-@@ -2438,41 +2425,40 @@ make sure all your user have a consistent environment when
- building. The syntax looks like
-
- @smallexample @c projectfile
-- aggregate project Agg is
-- for Project_Files use ("A.gpr", "B.gpr");
-- for Project_Path use ("../dir1", "../dir1/dir2");
-- for External ("BUILD") use "PRODUCTION";
--
-- package Builder is
-- for ^Switches^Switches^ ("Ada") use ("-q");
-- end Builder;
-- end Agg;
-+ aggregate @b{project} Agg @b{is}
-+ @b{for} Project_Files @b{use} ("A.gpr", "B.gpr");
-+ @b{for} Project_Path @b{use} ("../dir1", "../dir1/dir2");
-+ @b{for} External ("BUILD") @b{use} "PRODUCTION";
-+
-+ @b{package} Builder @b{is}
-+ @b{for} Switches ("Ada") @b{use} ("-q");
-+ @b{end} Builder;
-+ @b{end} Agg;
- @end smallexample
-
- One of the often requested features in projects is to be able to
--reference external variables in @code{with} statements, as in
-+reference external variables in @code{with} declarations, as in
-
- @smallexample @c projectfile
-- with external("SETUP") & "path/prj.gpr"; -- ILLEGAL
-- project MyProject is
-+ @b{with} @b{external}("SETUP") & "path/prj.gpr"; -- at i{ ILLEGAL}
-+ @b{project} MyProject @b{is}
- ...
-- end MyProject;
-+ @b{end} MyProject;
- @end smallexample
-
--For various reasons, this isn't authorized. But using aggregate
--projects provide an elegant solution. For instance, you could
--use a project file like:
-+For various reasons, this is not allowed. But using aggregate projects provide
-+an elegant solution. For instance, you could use a project file like:
-
- @smallexample @c projectfile
--aggregate project Agg is
-- for Project_Path use (external("SETUP") & "path");
-- for Project_Files use ("myproject.gpr");
--end Agg;
-+aggregate @b{project} Agg @b{is}
-+ @b{for} Project_Path @b{use} (@b{external}("SETUP") & "path");
-+ @b{for} Project_Files @b{use} ("myproject.gpr");
-+ at b{end} Agg;
-
--with "prj.gpr"; -- searched on Agg'Project_Path
--project MyProject is
-+ at b{with} "prj.gpr"; -- at i{ searched on Agg'Project_Path}
-+ at b{project} MyProject @b{is}
- ...
--end MyProject;
-+ at b{end} MyProject;
- @end smallexample
-
- @c --------------------------------------------
-@@ -2483,7 +2469,7 @@ end MyProject;
- The loading of aggregate projects is optimized in @command{gprbuild},
- so that all files are searched for only once on the disk
- (thus reducing the number of system calls and contributing to faster
--compilation times especially on systems with sources on remote
-+compilation times, especially on systems with sources on remote
- servers). As part of the loading, @command{gprbuild}
- computes how and where a source file should be compiled, and even if it is
- found several times in the aggregated projects it will be compiled only
-@@ -2534,12 +2520,9 @@ attributes and packages are forbidden in an aggregate project. Here is the
-
- The only package that is authorized (albeit optional) is
- Builder. Other packages (in particular Compiler, Binder and Linker)
--are forbidden. It is an error to have any of these
--(and such an error prevents the proper loading of the aggregate
--project).
-+are forbidden.
-
--Three new attributes have been created, which can only be used in the
--context of aggregate projects:
-+The following three attributes can be used only in an aggregate project:
-
- @table @asis
- @item @b{Project_Files}:
-@@ -2582,29 +2565,30 @@ number of system calls that are needed.
- Here are a few valid examples:
-
- @smallexample @c projectfile
-- for Project_Files use ("a.gpr", "subdir/b.gpr");
-- -- two specific projects relative to the directory of agg.gpr
-+ @b{for} Project_Files @b{use} ("a.gpr", "subdir/b.gpr");
-+ -- at i{ two specific projects relative to the directory of agg.gpr}
-
-- for Project_Files use ("**/*.gpr");
-- -- all projects recursively
-+ @b{for} Project_Files @b{use} ("**/*.gpr");
-+ -- at i{ all projects recursively}
- @end smallexample
-
- @item @b{Project_Path}:
- @cindex @code{Project_Path}
-
- This attribute can be used to specify a list of directories in
--which to look for project files in @code{with} statements.
-+which to look for project files in @code{with} declarations.
-
--When you specify a project in Project_Files
--say @code{"x/y/a.gpr"}), and this projects imports a project "b.gpr", only
--b.gpr is searched in the project path. a.gpr must be exactly at
--<dir of the aggregate>/x/y/a.gpr.
-+When you specify a project in Project_Files (say @code{x/y/a.gpr}), and
-+ at code{a.gpr} imports a project @code{b.gpr}, only @code{b.gpr} is searched in
-+the project path. @code{a.gpr} must be exactly at
-+ at code{<dir of the aggregate>/x/y/a.gpr}.
-
- This attribute, however, does not affect the search for the aggregated
- project files specified with @code{Project_Files}.
-
--Each aggregate project has its own (that is if agg1.gpr includes
--agg2.gpr, they can potentially both have a different project path).
-+Each aggregate project has its own @code{Project_Path} (that is if
-+ at code{agg1.gpr} includes @code{agg2.gpr}, they can potentially both have a
-+different @code{Project_Path}).
-
- This project path is defined as the concatenation, in that order, of:
-
-@@ -2653,23 +2637,23 @@ this will be reported as an error by the builder.
-
- Directories are relative to the location of the aggregate project file.
-
--Here are a few valid examples:
-+Example:
-
- @smallexample @c projectfile
-- for Project_Path use ("/usr/local/gpr", "gpr/");
-+ @b{for} Project_Path @b{use} ("/usr/local/gpr", "gpr/");
- @end smallexample
-
- @item @b{External}:
- @cindex @code{External}
-
- This attribute can be used to set the value of environment
--variables as retrieved through the @code{external} statement
-+variables as retrieved through the @code{external} function
- in projects. It does not affect the environment variables
- themselves (so for instance you cannot use it to change the value
- of your PATH as seen from the spawned compiler).
-
- This attribute affects the external values as seen in the rest of
--the aggreate projects, and in the aggregated projects.
-+the aggregate project, and in the aggregated projects.
-
- The exact value of external a variable comes from one of three
- sources (each level overrides the previous levels):
-@@ -2682,7 +2666,7 @@ sources (each level overrides the previous levels):
-
- These override the value given by the attribute, so that
- users can override the value set in the (presumably shared
--with others in his team) aggregate project.
-+with others team members) aggregate project.
-
- @item The -X command line switch to @command{gprbuild}
-
-@@ -2714,8 +2698,8 @@ an aggregate project. In this package, only the following attributes
- are valid:
-
- @table @asis
-- at item @b{^Switches^Switches^}:
-- at cindex @code{^Switches^Switches^}
-+ at item @b{Switches}:
-+ at cindex @code{Switches}
- This attribute gives the list of switches to use for @command{gprbuild}.
- Because no mains can be specified for aggregate projects, the only possible
- index for attribute @code{Switches} is @code{others}. All other indexes will
-@@ -2724,7 +2708,7 @@ be ignored.
- Example:
-
- @smallexample @c projectfile
--for ^Switches^Switches^ (other) use ("-v", "-k", "-j8");
-+ at b{for} Switches (@b{others}) @b{use} ("-v", "-k", "-j8");
- @end smallexample
-
- These switches are only read from the main aggregate project (the
-@@ -2740,8 +2724,8 @@ This attribute gives the list of compiler switches for the various
- languages. For instance,
-
- @smallexample @c projectfile
--for Global_Compilation_Switches ("Ada") use ("^O1^-O1^", "-g");
--for Global_Compilation_Switches ("C") use ("^-O2^-O2^");
-+ at b{for} Global_Compilation_Switches ("Ada") @b{use} ("O1", "-g");
-+ at b{for} Global_Compilation_Switches ("C") @b{use} ("-O2");
- @end smallexample
-
- This attribute is only taken into account in the aggregate project
-@@ -2760,57 +2744,57 @@ instance, aggregate project Agg groups the projects A and B, that
- both depend on C. Here is an extra for all of these projects:
-
- @smallexample @c projectfile
-- aggregate project Agg is
-- for Project_Files use ("a.gpr", "b.gpr");
-- package Builder is
-- for Global_Compilation_Switches ("Ada") use ("^-O2^-O2^");
-- end Builder;
-- end Agg;
--
-- with "c.gpr";
-- project A is
-- package Builder is
-- for Global_Compilation_Switches ("Ada") use ("^-O1^-O1^");
-- -- ignored
-- end Builder;
--
-- package Compiler is
-- for Default_Switches ("Ada")
-- use ("^-O1^-O1^", "-g");
-- for ^Switches^Switches^ ("a_file1.adb")
-- use ("^-O0^-O0^");
-- end Compiler;
-- end A;
--
-- with "c.gpr";
-- project B is
-- package Compiler is
-- for Default_Switches ("Ada") use ("^-O0^-O0^");
-- end Compiler;
-- end B;
--
-- project C is
-- package Compiler is
-- for Default_Switches ("Ada")
-- use ("^-O3^-O3^",
-- "^-gnatn^-gnatn^");
-- for ^Switches^Switches^ ("c_file1.adb")
-- use ("^-O0^-O0^", "-g");
-- end Compiler;
-- end C;
-+ aggregate @b{project} Agg @b{is}
-+ @b{for} Project_Files @b{use} ("a.gpr", "b.gpr");
-+ @b{package} Builder @b{is}
-+ @b{for} Global_Compilation_Switches ("Ada") @b{use} ("-O2");
-+ @b{end} Builder;
-+ @b{end} Agg;
-+
-+ @b{with} "c.gpr";
-+ @b{project} A @b{is}
-+ @b{package} Builder @b{is}
-+ @b{for} Global_Compilation_Switches ("Ada") @b{use} ("-O1");
-+ -- at i{ ignored}
-+ @b{end} Builder;
-+
-+ @b{package} Compiler @b{is}
-+ @b{for} Default_Switches ("Ada")
-+ @b{use} ("-O1", "-g");
-+ @b{for} Switches ("a_file1.adb")
-+ @b{use} ("-O0");
-+ @b{end} Compiler;
-+ @b{end} A;
-+
-+ @b{with} "c.gpr";
-+ @b{project} B @b{is}
-+ @b{package} Compiler @b{is}
-+ @b{for} Default_Switches ("Ada") @b{use} ("-O0");
-+ @b{end} Compiler;
-+ @b{end} B;
-+
-+ @b{project} C @b{is}
-+ @b{package} Compiler @b{is}
-+ @b{for} Default_Switches ("Ada")
-+ @b{use} ("-O3",
-+ "-gnatn");
-+ @b{for} Switches ("c_file1.adb")
-+ @b{use} ("-O0", "-g");
-+ @b{end} Compiler;
-+ @b{end} C;
- @end smallexample
-
- then the following switches are used:
-
- @itemize @bullet
- @item all files from project A except a_file1.adb are compiled
-- with "^-O2^-O2^ -g", since the aggregate project has priority.
-+ with "-O2 -g", since the aggregate project has priority.
- @item the file a_file1.adb is compiled with
-- "^-O0^-O0^", since the Compiler.Switches has priority
-+ "-O0", since the Compiler.Switches has priority
- @item all files from project B are compiled with
-- "^-O2^-O2^", since the aggregate project has priority
-- at item all files from C are compiled with "^-O2^-O2^ -gnatn", except for
-- c_file1.adb which is compiled with "^-O0^-O0^ -g"
-+ "-O2", since the aggregate project has priority
-+ at item all files from C are compiled with "-O2 -gnatn", except for
-+ c_file1.adb which is compiled with "-O0 -g"
- @end itemize
-
- Even though C is seen through two paths (through A and through
-@@ -2871,11 +2855,11 @@ For example, we can define an aggregate project Agg that groups A, B
- and C:
-
- @smallexample @c projectfile
-- aggregate library project Agg is
-- for Project_Files use ("a.gpr", "b.gpr", "c.gpr");
-- for Library_Name use ("agg");
-- for Library_Dir use ("lagg");
-- end Agg;
-+ aggregate library @b{project} Agg @b{is}
-+ @b{for} Project_Files @b{use} ("a.gpr", "b.gpr", "c.gpr");
-+ @b{for} Library_Name @b{use} ("agg");
-+ @b{for} Library_Dir @b{use} ("lagg");
-+ @b{end} Agg;
- @end smallexample
-
- Then, when you build with:
-@@ -2885,26 +2869,26 @@ Then, when you build with:
- @end smallexample
-
- This will build all units from projects A, B and C and will create a
--static library named @file{libagg.a} into the @file{lagg}
-+static library named @file{libagg.a} in the @file{lagg}
- directory. An aggregate library project has the same set of
- restriction as a standard library project.
-
--Note that a shared aggregate library project cannot aggregates a
-+Note that a shared aggregate library project cannot aggregate a
- static library project. In platforms where a compiler option is
- required to create relocatable object files, a Builder package in the
- aggregate library project may be used:
-
- @smallexample @c projectfile
-- aggregate library project Agg is
-- for Project_Files use ("a.gpr", "b.gpr", "c.gpr");
-- for Library_Name use ("agg");
-- for Library_Dir use ("lagg");
-- for Library_Kind use "relocatable";
--
-- package Builder is
-- for Global_Compilation_Switches ("Ada") use ("-fPIC");
-- end Builder;
-- end Agg;
-+ aggregate library @b{project} Agg @b{is}
-+ @b{for} Project_Files @b{use} ("a.gpr", "b.gpr", "c.gpr");
-+ @b{for} Library_Name @b{use} ("agg");
-+ @b{for} Library_Dir @b{use} ("lagg");
-+ @b{for} Library_Kind @b{use} "relocatable";
-+
-+ @b{package} Builder @b{is}
-+ @b{for} Global_Compilation_Switches ("Ada") @b{use} ("-fPIC");
-+ @b{end} Builder;
-+ @b{end} Agg;
- @end smallexample
-
- With the above aggregate library Builder package, the @code{-fPIC}
-@@ -2987,8 +2971,8 @@ Project files have an Ada-like syntax. The minimal project file is:
-
- @smallexample @c projectfile
- @group
--project Empty is
--end Empty;
-+ at b{project} Empty @b{is}
-+ at b{end} Empty;
- @end group
- @end smallexample
-
-@@ -3042,7 +3026,7 @@ GPR_PROJECT_PATH. Path names are case sensitive if file names in the host
- operating system are case sensitive. As a special case, the directory
- separator can always be "/" even on Windows systems, so that project files
- can be made portable across architectures.
--The syntax of the environment variable ADA_PROJECT_PATH and
-+The syntax of the environment variables ADA_PROJECT_PATH and
- GPR_PROJECT_PATH is a list of directory names separated by colons on UNIX and
- semicolons on Windows.
-
-@@ -3050,27 +3034,26 @@ A given project name can appear only once in a context clause.
-
- It is illegal for a project imported by a context clause to refer, directly
- or indirectly, to the project in which this context clause appears (the
--dependency graph cannot contain cycles), except when one of the with clause
-+dependency graph cannot contain cycles), except when one of the with clauses
- in the cycle is a @b{limited with}.
- @c ??? Need more details here
-
- @smallexample @c projectfile
--with "other_project.gpr";
--project My_Project extends "extended.gpr" is
--end My_Project;
-+ at b{with} "other_project.gpr";
-+ at b{project} My_Project @b{extends} "extended.gpr" @b{is}
-+ at b{end} My_Project;
- @end smallexample
-
- @noindent
- These dependencies form a @b{directed graph}, potentially cyclic when using
-- at b{limited with}. The subprogram reflecting the @b{extends} relations is a
--tree.
-+ at b{limited with}. The subgraph reflecting the @b{extends} relations is a tree.
-
- A project's @b{immediate sources} are the source files directly defined by
- that project, either implicitly by residing in the project source directories,
- or explicitly through any of the source-related attributes.
--More generally, a project sources are the immediate sources of the project
--together with the immediate sources (unless overridden) of any
--project on which it depends directly or indirectly.
-+More generally, a project's @b{sources} are the immediate sources of the
-+project together with the immediate sources (unless overridden) of any project
-+on which it depends directly or indirectly.
-
- A @b{project hierarchy} can be created, where projects are children of
- other projects. The name of such a child project must be @code{Parent.Child},
-@@ -3192,28 +3175,28 @@ The following packages are currently supported in project files
- @item Cross_Reference
- This package specifies the options used when calling the library tool
- @command{gnatxref} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
- @ifclear FSFEDITION
- @item Eliminate
- This package specifies the options used when calling the tool
- @command{gnatelim} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
- @end ifclear
- @item Finder
- This package specifies the options used when calling the search tool
- @command{gnatfind} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
-- at item ^Gnatls^Gnatls^
-+ at item Gnatls
- This package specifies the options to use when invoking @command{gnatls}
- via the @command{gnat} driver.
- @ifclear FSFEDITION
-- at item ^Gnatstub^Gnatstub^
-+ at item Gnatstub
- This package specifies the options used when calling the tool
- @command{gnatstub} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
- @end ifclear
- @item IDE
-@@ -3229,7 +3212,7 @@ The following packages are currently supported in project files
- @item Metrics
- This package specifies the options used when calling the tool
- @command{gnatmetric} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
- @end ifclear
- @item Naming
-@@ -3242,7 +3225,7 @@ The following packages are currently supported in project files
- @item Pretty_Printer
- This package specifies the options used when calling the formatting tool
- @command{gnatpp} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
- @end ifclear
- @item Remote
-@@ -3251,7 +3234,7 @@ The following packages are currently supported in project files
- @item Stack
- This package specifies the options used when calling the tool
- @command{gnatstack} via the @command{gnat} driver. Its attributes
-- @b{Default_Switches} and @b{^Switches^Switches^} have the same semantics as for the
-+ @b{Default_Switches} and @b{Switches} have the same semantics as for the
- package @code{Builder}.
- @item Synchronize
- This package specifies the options used when calling the tool
-@@ -3263,10 +3246,10 @@ In its simplest form, a package may be empty:
-
- @smallexample @c projectfile
- @group
--project Simple is
-- package Builder is
-- end Builder;
--end Simple;
-+ at b{project} Simple @b{is}
-+ @b{package} Builder @b{is}
-+ @b{end} Builder;
-+ at b{end} Simple;
- @end group
- @end smallexample
-
-@@ -3372,9 +3355,9 @@ strings is involved, the result of the concatenation is a list of strings. The
- following Ada declarations show the existing operators:
-
- @smallexample @c ada
-- function "&" (X : String; Y : String) return String;
-- function "&" (X : String_List; Y : String) return String_List;
-- function "&" (X : String_List; Y : String_List) return String_List;
-+ @b{function} "&" (X : String; Y : String) @b{return} String;
-+ @b{function} "&" (X : String_List; Y : String) @b{return} String_List;
-+ @b{function} "&" (X : String_List; Y : String_List) @b{return} String_List;
- @end smallexample
-
- @noindent
-@@ -3382,10 +3365,10 @@ Here are some specific examples:
-
- @smallexample @c projectfile
- @group
-- List := () & File_Name; -- One string in this list
-- List2 := List & (File_Name & ".orig"); -- Two strings
-- Big_List := List & Lists2; -- Three strings
-- Illegal := "gnat.adc" & List2; -- Illegal, must start with list
-+ List := () & File_Name; -- at i{ One string in this list}
-+ List2 := List & (File_Name & ".orig"); -- at i{ Two strings}
-+ Big_List := List & Lists2; -- at i{ Three strings}
-+ Illegal := "gnat.adc" & List2; -- at i{ Illegal, must start with list}
- @end group
- @end smallexample
-
-@@ -3415,9 +3398,9 @@ if present, is the default to use if there is no specification for this
- external value either on the command line or in the environment.
-
- Typically, the external value will either exist in the
--^environment variables^logical name^
-+environment variables
- or be specified on the command line through the
-- at option{^-X^/EXTERNAL_REFERENCE=^@emph{vbl}=@emph{value}} switch. If both
-+ at option{-X at emph{vbl}=@emph{value}} switch. If both
- are specified, then the command line value is used, so that a user can more
- easily override the value.
-
-@@ -3430,7 +3413,7 @@ list expression, and can therefore appear in a variable declaration or
- an attribute declaration.
-
- Most of the time, this construct is used to initialize typed variables, which
--are then used in @b{case} statements to control the value assigned to
-+are then used in @b{case} constructions to control the value assigned to
- attributes in various scenarios. Thus such variables are often called
- @b{scenario variables}.
-
-@@ -3460,14 +3443,14 @@ last separator and the end are components of the string list.
- @end smallexample
-
- @noindent
--If the external value is "^-O2^-O2^,-g",
--the result is ("^-O2^-O2^", "-g").
-+If the external value is "-O2,-g",
-+the result is ("-O2", "-g").
-
--If the external value is ",^-O2^-O2^,-g,",
--the result is also ("^-O2^-O2^", "-g").
-+If the external value is ",-O2,-g,",
-+the result is also ("-O2", "-g").
-
--if the external value is "^-gnatv^-gnatv^",
--the result is ("^-gnatv^-gnatv^").
-+if the external value is "-gnatv",
-+the result is ("-gnatv").
-
- If the external value is ",,", the result is ("").
-
-@@ -3496,7 +3479,7 @@ They may include any graphic characters allowed in Ada, including spaces.
- Here is an example of a string type declaration:
-
- @smallexample @c projectfile
-- type OS is ("NT", "nt", "Unix", "GNU/Linux", "other OS");
-+ @b{type} OS @b{is} ("NT", "nt", "Unix", "GNU/Linux", "other OS");
- @end smallexample
-
- @noindent
-@@ -3551,8 +3534,8 @@ Here are some examples of variable declarations:
-
- @smallexample @c projectfile
- @group
-- This_OS : OS := external ("OS"); -- a typed variable declaration
-- That_OS := "GNU/Linux"; -- an untyped variable declaration
-+ This_OS : OS := @b{external} ("OS"); -- at i{ a typed variable declaration}
-+ That_OS := "GNU/Linux"; -- at i{ an untyped variable declaration}
-
- Name := "readme.txt";
- Save_Name := Name & ".saved";
-@@ -3592,8 +3575,8 @@ A @b{context} may be one of the following:
- @c ---------------------------------------------
-
- @noindent
--A @b{case} statement is used in a project file to effect conditional
--behavior. Through this statement, you can set the value of attributes
-+A @b{case} construction is used in a project file to effect conditional
-+behavior. Through this construction, you can set the value of attributes
- and variables depending on the value previously assigned to a typed
- variable.
-
-@@ -3601,30 +3584,30 @@ All choices in a choice list must be distinct. Unlike Ada, the choice
- lists of all alternatives do not need to include all values of the type.
- An @code{others} choice must appear last in the list of alternatives.
-
--The syntax of a @code{case} construction is based on the Ada case statement
--(although the @code{null} statement for empty alternatives is optional).
-+The syntax of a @code{case} construction is based on the Ada case construction
-+(although the @code{null} declaration for empty alternatives is optional).
-
--The case expression must be a typed string variable, whose value is often
--given by an external reference (@pxref{External Values}).
-+The case expression must be a string variable, either typed or not, whose value
-+is often given by an external reference (@pxref{External Values}).
-
- Each alternative starts with the reserved word @code{when}, either a list of
- literal strings separated by the @code{"|"} character or the reserved word
- @code{others}, and the @code{"=>"} token.
--Each literal string must belong to the string type that is the type of the
--case variable.
--After each @code{=>}, there are zero or more statements. The only
--statements allowed in a case construction are other case constructions,
-+When the case expression is a typed string variable, each literal string must
-+belong to the string type that is the type of the case variable.
-+After each @code{=>}, there are zero or more declarations. The only
-+declarations allowed in a case construction are other case constructions,
- attribute declarations and variable declarations. String type declarations and
- package declarations are not allowed. Variable declarations are restricted to
- variables that have already been declared before the case construction.
-
- @smallexample
--case_statement ::=
-- @i{case} @i{<typed_variable_>}name @i{is} @{case_item@} @i{end case} ;
-+case_construction ::=
-+ @i{case} @i{<variable_>}name @i{is} @{case_item@} @i{end case} ;
-
- case_item ::=
- @i{when} discrete_choice_list =>
-- @{case_statement
-+ @{case_declaration
- | attribute_declaration
- | variable_declaration
- | empty_declaration@}
-@@ -3633,27 +3616,27 @@ discrete_choice_list ::= string_literal @{| string_literal@} | @i{others}
- @end smallexample
-
- @noindent
--Here is a typical example:
-+Here is a typical example, with a typed string variable:
-
- @smallexample @c projectfile
- @group
--project MyProj is
-- type OS_Type is ("GNU/Linux", "Unix", "NT", "VMS");
-- OS : OS_Type := external ("OS", "GNU/Linux");
--
-- package Compiler is
-- case OS is
-- when "GNU/Linux" | "Unix" =>
-- for ^Switches^Switches^ ("Ada")
-- use ("-gnath");
-- when "NT" =>
-- for ^Switches^Switches^ ("Ada")
-- use ("^-gnatP^-gnatP^");
-- when others =>
-- null;
-- end case;
-- end Compiler;
--end MyProj;
-+ at b{project} MyProj @b{is}
-+ @b{type} OS_Type @b{is} ("GNU/Linux", "Unix", "NT", "VMS");
-+ OS : OS_Type := @b{external} ("OS", "GNU/Linux");
-+
-+ @b{package} Compiler @b{is}
-+ @b{case} OS @b{is}
-+ @b{when} "GNU/Linux" | "Unix" =>
-+ @b{for} Switches ("Ada")
-+ @b{use} ("-gnath");
-+ @b{when} "NT" =>
-+ @b{for} Switches ("Ada")
-+ @b{use} ("-gnatP");
-+ @b{when} @b{others} =>
-+ @b{null};
-+ @b{end} @b{case};
-+ @b{end} Compiler;
-+ at b{end} MyProj;
- @end group
- @end smallexample
-
-@@ -3676,9 +3659,9 @@ end MyProj;
- * Package Eliminate Attributes::
- @end ifclear
- * Package Finder Attributes::
--* Package ^gnatls^gnatls^ Attributes::
-+* Package gnatls Attributes::
- @ifclear FSFEDITION
--* Package ^gnatstub^gnatstub^ Attributes::
-+* Package gnatstub Attributes::
- @end ifclear
- * Package IDE Attributes::
- * Package Install Attributes::
-@@ -3731,30 +3714,31 @@ attribute, and replaces the previous setting.
- Here are some examples of attribute declarations:
-
- @smallexample @c projectfile
-- -- simple attributes
-- for Object_Dir use "objects";
-- for Source_Dirs use ("units", "test/drivers");
--
-- -- indexed attributes
-- for Body ("main") use "Main.ada";
-- for ^Switches^Switches^ ("main.ada")
-- use ("-v", "^-gnatv^-gnatv^");
-- for ^Switches^Switches^ ("main.ada") use Builder'Switches ("main.ada") & "-g";
--
-- -- indexed attributes copy (from package Builder in project Default)
-- -- The package name must always be specified, even if it is the current
-- -- package.
-- for Default_Switches use Default.Builder'Default_Switches;
-+ -- at i{ simple attributes}
-+ @b{for} Object_Dir @b{use} "objects";
-+ @b{for} Source_Dirs @b{use} ("units", "test/drivers");
-+
-+ -- at i{ indexed attributes}
-+ @b{for} Body ("main") @b{use} "Main.ada";
-+ @b{for} Switches ("main.ada")
-+ @b{use} ("-v", "-gnatv");
-+ @b{for} Switches ("main.ada") @b{use} Builder'Switches ("main.ada") & "-g";
-+
-+ -- at i{ indexed attributes copy (from package Builder in project Default)}
-+ -- at i{ The package name must always be specified, even if it is the current}
-+ -- at i{ package.}
-+ @b{for} Default_Switches @b{use} Default.Builder'Default_Switches;
- @end smallexample
-
- @noindent
- Attributes references may appear anywhere in expressions, and are used
- to retrieve the value previously assigned to the attribute. If an attribute
- has not been set in a given package or project, its value defaults to the
--empty string or the empty list.
-+empty string or the empty list, with some exceptions.
-
- @smallexample
--attribute_reference ::= attribute_prefix ' @i{<simple_attribute>_}simple_name [ (string_literal) ]
-+attribute_reference ::=
-+ attribute_prefix ' @i{<simple_attribute>_}simple_name [ (string_literal) ]
- attribute_prefix ::= @i{project}
- | @i{<project_>}simple_name
- | package_identifier
-@@ -3765,13 +3749,22 @@ attribute_prefix ::= @i{project}
- Examples are:
-
- @smallexample @c projectfile
-- project'Object_Dir
-+ @b{project}'Object_Dir
- Naming'Dot_Replacement
- Imported_Project'Source_Dirs
- Imported_Project.Naming'Casing
- Builder'Default_Switches ("Ada")
- @end smallexample
-
-+The exceptions to the empty defaults are:
-+
-+ at itemize @bullet
-+ at item Object_Dir: default is "."
-+ at item Exec_Dir: default is 'Object_Dir, that is the value of attribute
-+ Object_Dir in the same project, declared or defaulted.
-+ at item Source_Dirs: default is (".")
-+ at end itemize
-+
- @noindent
- The prefix of an attribute may be:
-
-@@ -3791,8 +3784,8 @@ In the following sections, all predefined attributes are succinctly described,
- first the project level attributes, that is those attributes that are not in a
- package, then the attributes in the different packages.
-
--It is possible for different tools to create dynamically new packages with
--attributes, or new attribute in predefined packages. These attributes are
-+It is possible for different tools to dynamically create new packages with
-+attributes, or new attributes in predefined packages. These attributes are
- not documented here.
-
- The attributes under Configuration headings are usually found only in
-@@ -4100,9 +4093,9 @@ directory in the run path options.
-
- @item @b{Separate_Run_Path_Options}: single
-
--Indicates if there may be or not several run path options specified when
--linking an executable. Only authorized case-insensitive b=values are "true" or
--"false" (the default).
-+Indicates if there may be several run path options specified when linking an
-+executable. Only authorized case-insensitive values are "true" or "false" (the
-+default).
-
- @item @b{Toolchain_Version}: single, indexed, case-insensitive index
-
-@@ -4126,7 +4119,14 @@ case-insensitive values are "false" and "true" (the default).
-
- @item @b{Target}: single
-
--Value is the name of the target platform.
-+Value is the name of the target platform. Taken into account only in the main
-+project.
-+
-+ at item @b{Runtime}: single, indexed, case-insensitive index
-+
-+Index is a language name. Indicates the runtime directory that is to be used
-+when using the compiler of the language. Taken into account only in the main
-+project.
-
- @end itemize
-
-@@ -4244,9 +4244,9 @@ sources of runtime libraries are located.
- @item @b{Default_Switches}: list, indexed, case-insensitive index
-
- Index is a language name. Value is the list of switches to be used when binding
--code of the language, if there is no applicable attribute ^Switches^Switches^.
-+code of the language, if there is no applicable attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed,
-+ at item @b{Switches}: list, optional index, indexed,
- case-insensitive index, others allowed
-
- Index is either a language name or a source file name. Value is the list of
-@@ -4301,7 +4301,7 @@ Index is a language name. Value is the list of builder switches to be used when
- building an executable of the language, if there is no applicable attribute
- Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is either a language name or a source file name. Value is the list of
-@@ -4348,9 +4348,9 @@ project tree.
-
- Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatcheck} for a source of the language, if there is no applicable
--attribute ^Switches^Switches^.
-+attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -4364,7 +4364,7 @@ invoking @code{gnatcheck} for the source.
-
- @itemize @bullet
-
-- at item @b{^Switches^Switches^}: list
-+ at item @b{Switches}: list
-
- Value is a list of switches to be used by the cleaning application.
-
-@@ -4407,7 +4407,7 @@ Index is a language name. Value is a list of switches to be used when invoking
- the compiler for the language for a source of the project, if there is no
- applicable attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name or a language name. Value is the list of switches
-@@ -4641,7 +4641,7 @@ Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatxref} for a source of the language, if there is no applicable
- attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -4661,7 +4661,7 @@ Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatelim} for a source of the language, if there is no applicable
- attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -4681,7 +4681,7 @@ Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatfind} for a source of the language, if there is no applicable
- attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -4689,20 +4689,20 @@ invoking @code{gnatfind} for the source.
-
- @end itemize
-
-- at node Package ^gnatls^gnatls^ Attributes
-- at subsubsection Package ^gnatls^gnatls^ Attributes
-+ at node Package gnatls Attributes
-+ at subsubsection Package gnatls Attributes
-
- @itemize @bullet
-
-- at item @b{^Switches^Switches^}: list
-+ at item @b{Switches}: list
-
- Value is a list of switches to be used when invoking @code{gnatls}.
-
- @end itemize
-
- @ifclear FSFEDITION
-- at node Package ^gnatstub^gnatstub^ Attributes
-- at subsubsection Package ^gnatstub^gnatstub^ Attributes
-+ at node Package gnatstub Attributes
-+ at subsubsection Package gnatstub Attributes
-
- @itemize @bullet
-
-@@ -4710,9 +4710,9 @@ Value is a list of switches to be used when invoking @code{gnatls}.
-
- Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatstub} for a source of the language, if there is no applicable
--attribute ^Switches^Switches^.
-+attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -4760,11 +4760,11 @@ the handling of switches.
- Value is a string that specifies the name of the debugger to be used, such as
- gdb, powerpc-wrs-vxworks-gdb or gdb-4.
-
-- at item @b{^gnatlist^gnatlist^}: single
-+ at item @b{gnatlist}: single
-
--Value is a string that specifies the name of the @command{^gnatls^gnatls^} utility
-+Value is a string that specifies the name of the @command{gnatls} utility
- to be used to retrieve information about the predefined path; for example,
-- at code{"^gnatls^gnatls^"}, @code{"powerpc-wrs-vxworks-gnatls"}.
-+ at code{"gnatls"}, @code{"powerpc-wrs-vxworks-gnatls"}.
-
- @item @b{VCS_Kind}: single
-
-@@ -4795,6 +4795,13 @@ Value is the directory used to generate the documentation of source code.
-
- @itemize @bullet
-
-+ at item @b{Artifacts}: list, indexed
-+
-+An array attribute to declare a set of files not part of the sources
-+to be installed. The array discriminant is the directory where the
-+file is to be installed. If a relative directory then Prefix (see
-+below) is prepended.
-+
- @item @b{Prefix}: single
-
- Value is the install destination directory.
-@@ -4821,6 +4828,15 @@ Indicates that the project is to be installed or not. Case-insensitive value
- "false" means that the project is not to be installed, all other values mean
- that the project is to be installed.
-
-+ at item @b{Mode}: single
-+
-+Value is the installation mode, it is either @b{dev} (default) or @b{usage}.
-+
-+ at item @b{Install_Name}: single
-+
-+Specify the name to use for recording the installation. The default is
-+the project name without the extension.
-+
- @end itemize
-
- @node Package Linker Attributes
-@@ -4850,7 +4866,7 @@ Index is a source file name or a language name. Value is the list of switches
- to be used at the beginning of the command line when invoking the linker to
- build an executable for the source or for its language.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name or a language name. Value is the list of switches
-@@ -4924,7 +4940,7 @@ Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatmetric} for a source of the language, if there is no applicable
- attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -5014,7 +5030,7 @@ Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatpp} for a source of the language, if there is no applicable
- attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
-@@ -5059,7 +5075,7 @@ Value is the root directory used by the slave machines.
-
- @itemize @bullet
-
-- at item @b{^Switches^Switches^}: list
-+ at item @b{Switches}: list
-
- Value is the list of switches to be used when invoking @code{gnatstack}.
-
-@@ -5076,11 +5092,10 @@ Index is a language name. Value is a list of switches to be used when invoking
- @code{gnatsync} for a source of the language, if there is no applicable
- attribute Switches.
-
-- at item @b{^Switches^Switches^}: list, optional index, indexed, case-insensitive index,
-+ at item @b{Switches}: list, optional index, indexed, case-insensitive index,
- others allowed
-
- Index is a source file name. Value is the list of switches to be used when
- invoking @code{gnatsync} for the source.
-
- @end itemize
--
-diff --git a/gnat/restrict.adb b/gnat/restrict.adb
-index 8983f78..661a05a 100644
---- a/gnat/restrict.adb
-+++ b/gnat/restrict.adb
-@@ -128,6 +128,10 @@ package body Restrict is
- -- real violation, serious vs non-serious, implicit vs explicit, the second
- -- message giving the profile name if needed, and the location information.
-
-+ function Same_Entity (E1, E2 : Node_Id) return Boolean;
-+ -- Returns True iff E1 and E2 represent the same entity. Used for handling
-+ -- of No_Use_Of_Entity => fully_qualified_ENTITY restriction case.
-+
- function Same_Unit (U1, U2 : Node_Id) return Boolean;
- -- Returns True iff U1 and U2 represent the same library unit. Used for
- -- handling of No_Dependence => Unit restriction case.
-@@ -427,6 +431,7 @@ package body Restrict is
- if VV < 0 then
- Info.Unknown (R) := True;
- Info.Count (R) := 1;
-+
- else
- Info.Count (R) := VV;
- end if;
-@@ -442,10 +447,11 @@ package body Restrict is
- if VV < 0 then
- Info.Unknown (R) := True;
-
-- -- If checked by maximization, do maximization
-+ -- If checked by maximization, nothing to do because the
-+ -- check is per-object.
-
- elsif R in Checked_Max_Parameter_Restrictions then
-- Info.Count (R) := Integer'Max (Info.Count (R), VV);
-+ null;
-
- -- If checked by adding, do add, checking for overflow
-
-@@ -489,7 +495,7 @@ package body Restrict is
- -- No_Dispatch restriction is not set.
-
- if R = No_Dispatch then
-- Check_SPARK_Restriction ("class-wide is not allowed", N);
-+ Check_SPARK_05_Restriction ("class-wide is not allowed", N);
- end if;
-
- if UI_Is_In_Int_Range (V) then
-@@ -554,6 +560,14 @@ package body Restrict is
- Msg_Issued := True;
- Restriction_Msg (R, N);
- end if;
-+
-+ -- For Max_Entries and the like, do not carry forward the violation
-+ -- count because it does not affect later declarations.
-+
-+ if R in Checked_Max_Parameter_Restrictions then
-+ Restrictions.Count (R) := 0;
-+ Restrictions.Violated (R) := False;
-+ end if;
- end Check_Restriction;
-
- -------------------------------------
-@@ -671,6 +685,98 @@ package body Restrict is
- end Check_Restriction_No_Use_Of_Attribute;
-
- ----------------------------------------
-+ -- Check_Restriction_No_Use_Of_Entity --
-+ ----------------------------------------
-+
-+ procedure Check_Restriction_No_Use_Of_Entity (N : Node_Id) is
-+ begin
-+ -- Error defence (not clearly necessary, but better safe)
-+
-+ if No (Entity (N)) then
-+ return;
-+ end if;
-+
-+ -- If simple name of entity not flagged with Boolean2 flag, then there
-+ -- cannot be a matching entry in the table, so skip the search.
-+
-+ if Get_Name_Table_Boolean2 (Chars (Entity (N))) = False then
-+ return;
-+ end if;
-+
-+ -- Restriction is only recognized within a configuration
-+ -- pragma file, or within a unit of the main extended
-+ -- program. Note: the test for Main_Unit is needed to
-+ -- properly include the case of configuration pragma files.
-+
-+ if Current_Sem_Unit /= Main_Unit
-+ and then not In_Extended_Main_Source_Unit (N)
-+ then
-+ return;
-+ end if;
-+
-+ -- Here we must search the table
-+
-+ for J in No_Use_Of_Entity.First .. No_Use_Of_Entity.Last loop
-+ declare
-+ NE_Ent : NE_Entry renames No_Use_Of_Entity.Table (J);
-+ Ent : Entity_Id;
-+ Expr : Node_Id;
-+
-+ begin
-+ Ent := Entity (N);
-+ Expr := NE_Ent.Entity;
-+ loop
-+ -- Here if at outer level of entity name in reference
-+
-+ if Scope (Ent) = Standard_Standard then
-+ if Nkind_In (Expr, N_Identifier, N_Operator_Symbol)
-+ and then Chars (Ent) = Chars (Expr)
-+ then
-+ Error_Msg_Node_1 := N;
-+ Error_Msg_Warn := NE_Ent.Warn;
-+ Error_Msg_Sloc := Sloc (NE_Ent.Entity);
-+ Error_Msg_N
-+ ("<*<reference to & violates restriction "
-+ & "No_Use_Of_Entity #", N);
-+ return;
-+
-+ else
-+ goto Continue;
-+ end if;
-+
-+ -- Here if at outer level of entity name in table
-+
-+ elsif Nkind_In (Expr, N_Identifier, N_Operator_Symbol) then
-+ goto Continue;
-+
-+ -- Here if neither at the outer level
-+
-+ else
-+ pragma Assert (Nkind (Expr) = N_Selected_Component);
-+
-+ if Chars (Selector_Name (Expr)) /= Chars (Ent) then
-+ goto Continue;
-+ end if;
-+ end if;
-+
-+ -- Move up a level
-+
-+ loop
-+ Ent := Scope (Ent);
-+ exit when not Is_Internal_Name (Chars (Ent));
-+ end loop;
-+
-+ Expr := Prefix (Expr);
-+
-+ -- Entry did not match
-+
-+ <<Continue>> null;
-+ end loop;
-+ end;
-+ end loop;
-+ end Check_Restriction_No_Use_Of_Entity;
-+
-+ ----------------------------------------
- -- Check_Restriction_No_Use_Of_Pragma --
- ----------------------------------------
-
-@@ -854,12 +960,33 @@ package body Restrict is
- end if;
- end OK_No_Dependence_Unit_Name;
-
-+ ------------------------------
-+ -- OK_No_Use_Of_Entity_Name --
-+ ------------------------------
-+
-+ function OK_No_Use_Of_Entity_Name (N : Node_Id) return Boolean is
-+ begin
-+ if Nkind (N) = N_Selected_Component then
-+ return
-+ OK_No_Use_Of_Entity_Name (Prefix (N))
-+ and then
-+ OK_No_Use_Of_Entity_Name (Selector_Name (N));
-+
-+ elsif Nkind_In (N, N_Identifier, N_Operator_Symbol) then
-+ return True;
-+
-+ else
-+ Error_Msg_N ("wrong form for entity name for No_Use_Of_Entity", N);
-+ return False;
-+ end if;
-+ end OK_No_Use_Of_Entity_Name;
-+
- ----------------------------------
- -- Process_Restriction_Synonyms --
- ----------------------------------
-
-- -- Note: body of this function must be coordinated with list of
-- -- renaming declarations in System.Rident.
-+ -- Note: body of this function must be coordinated with list of renaming
-+ -- declarations in System.Rident.
-
- function Process_Restriction_Synonyms (N : Node_Id) return Name_Id
- is
-@@ -1136,6 +1263,30 @@ package body Restrict is
- end if;
- end Restriction_Msg;
-
-+ -----------------
-+ -- Same_Entity --
-+ -----------------
-+
-+ function Same_Entity (E1, E2 : Node_Id) return Boolean is
-+ begin
-+ if Nkind_In (E1, N_Identifier, N_Operator_Symbol)
-+ and then
-+ Nkind_In (E2, N_Identifier, N_Operator_Symbol)
-+ then
-+ return Chars (E1) = Chars (E2);
-+
-+ elsif Nkind_In (E1, N_Selected_Component, N_Expanded_Name)
-+ and then
-+ Nkind_In (E2, N_Selected_Component, N_Expanded_Name)
-+ then
-+ return Same_Unit (Prefix (E1), Prefix (E2))
-+ and then
-+ Same_Unit (Selector_Name (E1), Selector_Name (E2));
-+ else
-+ return False;
-+ end if;
-+ end Same_Entity;
-+
- ---------------
- -- Same_Unit --
- ---------------
-@@ -1350,6 +1501,54 @@ package body Restrict is
- No_Dependences.Append ((Unit, Warn, Profile));
- end Set_Restriction_No_Dependence;
-
-+ --------------------------------------
-+ -- Set_Restriction_No_Use_Of_Entity --
-+ --------------------------------------
-+
-+ procedure Set_Restriction_No_Use_Of_Entity
-+ (Entity : Node_Id;
-+ Warn : Boolean;
-+ Profile : Profile_Name := No_Profile)
-+ is
-+ Nam : Node_Id;
-+
-+ begin
-+ -- Loop to check for duplicate entry
-+
-+ for J in No_Use_Of_Entity.First .. No_Use_Of_Entity.Last loop
-+
-+ -- Case of entry already in table
-+
-+ if Same_Entity (Entity, No_Use_Of_Entity.Table (J).Entity) then
-+
-+ -- Error has precedence over warning
-+
-+ if not Warn then
-+ No_Use_Of_Entity.Table (J).Warn := False;
-+ end if;
-+
-+ return;
-+ end if;
-+ end loop;
-+
-+ -- Entry is not currently in table
-+
-+ No_Use_Of_Entity.Append ((Entity, Warn, Profile));
-+
-+ -- Now we need to find the direct name and set Boolean2 flag
-+
-+ if Nkind_In (Entity, N_Identifier, N_Operator_Symbol) then
-+ Nam := Entity;
-+
-+ else
-+ pragma Assert (Nkind (Entity) = N_Selected_Component);
-+ Nam := Selector_Name (Entity);
-+ pragma Assert (Nkind_In (Nam, N_Identifier, N_Operator_Symbol));
-+ end if;
-+
-+ Set_Name_Table_Boolean2 (Chars (Nam), True);
-+ end Set_Restriction_No_Use_Of_Entity;
-+
- ------------------------------------------------
- -- Set_Restriction_No_Specification_Of_Aspect --
- ------------------------------------------------
-@@ -1408,11 +1607,11 @@ package body Restrict is
- end if;
- end Set_Restriction_No_Use_Of_Pragma;
-
-- -----------------------------
-- -- Check_SPARK_Restriction --
-- -----------------------------
-+ --------------------------------
-+ -- Check_SPARK_05_Restriction --
-+ --------------------------------
-
-- procedure Check_SPARK_Restriction
-+ procedure Check_SPARK_05_Restriction
- (Msg : String;
- N : Node_Id;
- Force : Boolean := False)
-@@ -1461,9 +1660,9 @@ package body Restrict is
- Error_Msg_F ("\\| " & Msg, N);
- end if;
- end if;
-- end Check_SPARK_Restriction;
-+ end Check_SPARK_05_Restriction;
-
-- procedure Check_SPARK_Restriction (Msg1, Msg2 : String; N : Node_Id) is
-+ procedure Check_SPARK_05_Restriction (Msg1, Msg2 : String; N : Node_Id) is
- Msg_Issued : Boolean;
- Save_Error_Msg_Sloc : Source_Ptr;
-
-@@ -1490,7 +1689,7 @@ package body Restrict is
- Error_Msg_F (Msg2, N);
- end if;
- end if;
-- end Check_SPARK_Restriction;
-+ end Check_SPARK_05_Restriction;
-
- ----------------------------------
- -- Suppress_Restriction_Message --
-@@ -1523,7 +1722,8 @@ package body Restrict is
- begin
- return not Restrictions.Set (No_Tasking)
- and then (not Restrictions.Set (Max_Tasks)
-- or else Restrictions.Value (Max_Tasks) > 0);
-+ or else Restrictions.Value (Max_Tasks) > 0)
-+ and then not No_Run_Time_Mode;
- end Tasking_Allowed;
-
- end Restrict;
-diff --git a/gnat/restrict.ads b/gnat/restrict.ads
-index 5cae0d6..e683a71 100644
---- a/gnat/restrict.ads
-+++ b/gnat/restrict.ads
-@@ -51,8 +51,8 @@ package Restrict is
- -- set from package Standard by the processing in Targparm.
-
- Restriction_Profile_Name : array (All_Restrictions) of Profile_Name;
-- -- Entries in this array are valid only if the corresponding restriction
-- -- in Restrictions set. The value is the corresponding profile name if the
-+ -- Entries in this array are valid only if the corresponding restriction in
-+ -- Restrictions is set. The value is the corresponding profile name if the
- -- restriction was set by a Profile or Profile_Warnings pragma. The value
- -- is No_Profile in all other cases.
-
-@@ -148,6 +148,10 @@ package Restrict is
- SPARK_05 => True,
- others => False);
-
-+ --------------------------
-+ -- No_Dependences Table --
-+ --------------------------
-+
- -- The following table records entries made by Restrictions pragmas
- -- that specify a parameter for No_Dependence. Each such pragma makes
- -- an entry in this table.
-@@ -179,6 +183,43 @@ package Restrict is
- Table_Increment => 200,
- Table_Name => "Name_No_Dependences");
-
-+ ----------------------------
-+ -- No_Use_Of_Entity Table --
-+ ----------------------------
-+
-+ -- The following table records entries made by Restrictions pragmas
-+ -- that specify a parameter for No_Use_Of_Entity. Each such pragma makes
-+ -- an entry in this table.
-+
-+ -- Note: we have chosen to implement this restriction in the "syntactic"
-+ -- form, where we allow arbitrary fully qualified names to be specified.
-+
-+ type NE_Entry is record
-+ Entity : Node_Id;
-+ -- The entity parameter from the No_Use_Of_Entity pragma. This is in
-+ -- the form of a selected component, since that is the way the parser
-+ -- processes it, and we don't further analyze it.
-+
-+ Warn : Boolean;
-+ -- True if from Restriction_Warnings, False if from Restrictions
-+
-+ Profile : Profile_Name;
-+ -- Set to name of profile from which No_Use_Of_Entity entry came, or to
-+ -- No_Profile if a pragma Restriction set the No_Use_Of_Entity entry.
-+ end record;
-+
-+ package No_Use_Of_Entity is new Table.Table (
-+ Table_Component_Type => NE_Entry,
-+ Table_Index_Type => Int,
-+ Table_Low_Bound => 0,
-+ Table_Initial => 200,
-+ Table_Increment => 200,
-+ Table_Name => "Name_No_Use_Of_Entity");
-+
-+ -- Note that in addition to making an entry in this table, we also set the
-+ -- Boolean2 flag of the Name_Table entry for the simple name of the entity.
-+ -- This is used to avoid most useless searches of this table.
-+
- -----------------
- -- Subprograms --
- -----------------
-@@ -232,16 +273,6 @@ package Restrict is
- -- Wrapper on Check_Restriction with Msg_Issued, with the out-parameter
- -- being ignored here.
-
-- procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id);
-- -- N is the node of an attribute definition clause. An error message
-- -- (warning) will be issued if a restriction (warning) was previously set
-- -- for this attribute using Set_No_Use_Of_Attribute.
--
-- procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id);
-- -- N is the node of a pragma. An error message (warning) will be issued
-- -- if a restriction (warning) was previously set for this pragma using
-- -- Set_No_Use_Of_Pragma.
--
- procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id);
- -- Called when a dependence on a unit is created (either implicitly, or by
- -- an explicit WITH clause). U is a node for the unit involved, and Err is
-@@ -252,13 +283,28 @@ package Restrict is
- -- (warning) will be issued if a restriction (warning) was previous set
- -- for this aspect using Set_No_Specification_Of_Aspect.
-
-+ procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id);
-+ -- N is the node of an attribute definition clause. An error message
-+ -- (warning) will be issued if a restriction (warning) was previously set
-+ -- for this attribute using Set_No_Use_Of_Attribute.
-+
-+ procedure Check_Restriction_No_Use_Of_Entity (N : Node_Id);
-+ -- N is the node id for an entity reference. An error message (warning)
-+ -- will be issued if a restriction (warning) was previous set for this
-+ -- entity name using Set_No_Use_Of_Entity.
-+
-+ procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id);
-+ -- N is the node of a pragma. An error message (warning) will be issued
-+ -- if a restriction (warning) was previously set for this pragma using
-+ -- Set_No_Use_Of_Pragma.
-+
- procedure Check_Elaboration_Code_Allowed (N : Node_Id);
- -- Tests to see if elaboration code is allowed by the current restrictions
- -- settings. This function is called by Gigi when it needs to define an
- -- elaboration routine. If elaboration code is not allowed, an error
- -- message is posted on the node given as argument.
-
-- procedure Check_SPARK_Restriction
-+ procedure Check_SPARK_05_Restriction
- (Msg : String;
- N : Node_Id;
- Force : Boolean := False);
-@@ -267,9 +313,9 @@ package Restrict is
- -- the SPARK_05 restriction is set, then an error is issued on N. Msg
- -- is appended to the restriction failure message.
-
-- procedure Check_SPARK_Restriction (Msg1, Msg2 : String; N : Node_Id);
-- -- Same as Check_SPARK_Restriction except there is a continuation message
-- -- Msg2 following the initial message Msg1.
-+ procedure Check_SPARK_05_Restriction (Msg1, Msg2 : String; N : Node_Id);
-+ -- Same as Check_SPARK_05_Restriction except there is a continuation
-+ -- message Msg2 following the initial message Msg1.
-
- procedure Check_No_Implicit_Aliasing (Obj : Node_Id);
- -- Obj is a node for which Is_Aliased_View is True, which is being used in
-@@ -315,6 +361,11 @@ package Restrict is
- -- pragma Restrictions_Warning, or attribute Restriction_Set. Returns
- -- True if N has the proper form for a unit name, False otherwise.
-
-+ function OK_No_Use_Of_Entity_Name (N : Node_Id) return Boolean;
-+ -- Used in checking No_Use_Of_Entity argument of pragma Restrictions or
-+ -- pragma Restrictions_Warning, or attribute Restriction_Set. Returns
-+ -- True if N has the proper form for an entity name, False otherwise.
-+
- function Is_In_Hidden_Part_In_SPARK (Loc : Source_Ptr) return Boolean;
- -- Determine if given location is covered by a hidden region range in the
- -- SPARK hides table.
-@@ -336,7 +387,6 @@ package Restrict is
- -- Id is a node whose Chars field contains the name of a restriction.
- -- If it is one of synonyms that we allow for historical purposes (for
- -- list see System.Rident), then the proper official name is returned.
-- -- Otherwise the Chars field of the argument is returned unchanged.
-
- function Restriction_Active (R : All_Restrictions) return Boolean;
- pragma Inline (Restriction_Active);
-@@ -420,6 +470,18 @@ package Restrict is
- -- No_Use_Of_Attribute. Caller has verified that this is a valid attribute
- -- designator.
-
-+ procedure Set_Restriction_No_Use_Of_Entity
-+ (Entity : Node_Id;
-+ Warn : Boolean;
-+ Profile : Profile_Name := No_Profile);
-+ -- Sets given No_Use_Of_Entity restriction in table if not there already.
-+ -- Warn is True if from Restriction_Warnings, or for Restrictions if the
-+ -- flag Treat_Restrictions_As_Warnings is set. False if from Restrictions
-+ -- and this flag is not set. Profile is set to a non-default value if the
-+ -- No_Dependence restriction comes from a Profile pragma. This procedure
-+ -- also takes care of setting the Boolean2 flag of the simple name for
-+ -- the entity (to optimize table searches).
-+
- procedure Set_Restriction_No_Use_Of_Pragma
- (N : Node_Id;
- Warning : Boolean);
-diff --git a/gnat/rident.ads b/gnat/rident.ads
-index ddafe14..615e17b 100644
---- a/gnat/rident.ads
-+++ b/gnat/rident.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/scans.adb b/gnat/scans.adb
-index 9bdaa71..121ab11 100644
---- a/gnat/scans.adb
-+++ b/gnat/scans.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/scans.ads b/gnat/scans.ads
-index dc8c19d..682bb6c 100644
---- a/gnat/scans.ads
-+++ b/gnat/scans.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -472,6 +472,10 @@ package Scans is
- -- Is it really right for this to be a Name rather than a String, what
- -- about the case of Wide_Wide_Characters???
-
-+ Inside_Depends : Boolean := False;
-+ -- Flag set True for parsing the argument of a Depends pragma or aspect
-+ -- (used to allow/require non-standard style rules for =>+ with -gnatyt).
-+
- Inside_If_Expression : Nat := 0;
- -- This is a counter that is set non-zero while scanning out an if
- -- expression (incremented on entry, decremented on exit). It is used to
-diff --git a/gnat/scng.adb b/gnat/scng.adb
-index 8ccdda6..3e31e5a 100644
---- a/gnat/scng.adb
-+++ b/gnat/scng.adb
-@@ -1571,7 +1571,7 @@ package body Scng is
- Token := Tok_Arrow;
-
- if Style_Check then
-- Style.Check_Arrow;
-+ Style.Check_Arrow (Inside_Depends);
- end if;
-
- return;
-diff --git a/gnat/sem_aux.adb b/gnat/sem_aux.adb
-index bd5363f..f149cba 100644
---- a/gnat/sem_aux.adb
-+++ b/gnat/sem_aux.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -18,12 +18,12 @@
- -- Public License distributed with GNAT; see file COPYING3. If not, go to --
- -- http://www.gnu.org/licenses for a complete copy of the license. --
- -- --
---- --
---- --
---- --
---- --
---- --
---- --
-+-- 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. --
-@@ -282,6 +282,8 @@ package body Sem_Aux is
- (Typ : Entity_Id) return Boolean;
- -- Scans the Discriminants to see whether any are Completely_Hidden
- -- (the mechanism for describing non-specified stored discriminants)
-+ -- Note that the entity list for the type may contain anonymous access
-+ -- types created by expressions that constrain access discriminants.
-
- ----------------------------------------
- -- Has_Completely_Hidden_Discriminant --
-@@ -296,8 +298,17 @@ package body Sem_Aux is
- pragma Assert (Ekind (Typ) = E_Discriminant);
-
- Ent := Typ;
-- while Present (Ent) and then Ekind (Ent) = E_Discriminant loop
-- if Is_Completely_Hidden (Ent) then
-+ while Present (Ent) loop
-+
-+ -- Skip anonymous types that may be created by expressions
-+ -- used as discriminant constraints on inherited discriminants.
-+
-+ if Is_Itype (Ent) then
-+ null;
-+
-+ elsif Ekind (Ent) = E_Discriminant
-+ and then Is_Completely_Hidden (Ent)
-+ then
- return True;
- end if;
-
-@@ -322,7 +333,8 @@ package body Sem_Aux is
-
- if Has_Completely_Hidden_Discriminant (Ent) then
- while Present (Ent) loop
-- exit when Is_Completely_Hidden (Ent);
-+ exit when Ekind (Ent) = E_Discriminant
-+ and then Is_Completely_Hidden (Ent);
- Ent := Next_Entity (Ent);
- end loop;
- end if;
-@@ -969,6 +981,12 @@ package body Sem_Aux is
- if Is_Type (Ent)
- and then Base_Type (Ent) /= Root_Type (Ent)
- and then not Is_Class_Wide_Type (Ent)
-+
-+ -- An access_to_subprogram whose result type is a limited view can
-+ -- appear in a return statement, without the full view of the result
-+ -- type being available. Do not interpret this as a derived type.
-+
-+ and then Ekind (Ent) /= E_Subprogram_Type
- then
- if not Is_Numeric_Type (Root_Type (Ent)) then
- return True;
-diff --git a/gnat/sem_aux.ads b/gnat/sem_aux.ads
-index 22002ae..bb539e2 100644
---- a/gnat/sem_aux.ads
-+++ b/gnat/sem_aux.ads
-@@ -18,12 +18,12 @@
- -- Public License distributed with GNAT; see file COPYING3. If not, go to --
- -- http://www.gnu.org/licenses for a complete copy of the license. --
- -- --
---- --
---- --
---- --
---- --
---- --
---- --
-+-- 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. --
-@@ -131,7 +131,7 @@ package Sem_Aux is
- -- stored discriminants are the same as the actual discriminants of the
- -- type, and hence this function is the same as First_Discriminant.
- --
-- -- For derived non-tagged types that rename discriminants in the root type
-+ -- For derived untagged types that rename discriminants in the root type
- -- this is the first of the discriminants that occur in the root type. To
- -- be precise, in this case stored discriminants are entities attached to
- -- the entity chain of the derived type which are a copy of the
-diff --git a/gnat/sinfo.adb b/gnat/sinfo.adb
-index 7fe3727..e9f6dd7 100644
---- a/gnat/sinfo.adb
-+++ b/gnat/sinfo.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -1041,15 +1041,6 @@ package body Sinfo is
- return Flag4 (N);
- end Elaborate_Present;
-
-- function Elaboration_Boolean
-- (N : Node_Id) return Node_Id is
-- begin
-- pragma Assert (False
-- or else NT (N).Nkind = N_Function_Specification
-- or else NT (N).Nkind = N_Procedure_Specification);
-- return Node2 (N);
-- end Elaboration_Boolean;
--
- function Else_Actions
- (N : Node_Id) return List_Id is
- begin
-@@ -1898,6 +1889,14 @@ package body Sinfo is
- return Flag11 (N);
- end Is_In_Discriminant_Check;
-
-+ function Is_Inherited
-+ (N : Node_Id) return Boolean is
-+ begin
-+ pragma Assert (False
-+ or else NT (N).Nkind = N_Pragma);
-+ return Flag4 (N);
-+ end Is_Inherited;
-+
- function Is_Machine_Number
- (N : Node_Id) return Boolean is
- begin
-@@ -2488,15 +2487,6 @@ package body Sinfo is
- return List3 (N);
- end Parameter_Associations;
-
-- function Parameter_List_Truncated
-- (N : Node_Id) return Boolean is
-- begin
-- pragma Assert (False
-- or else NT (N).Nkind = N_Function_Call
-- or else NT (N).Nkind = N_Procedure_Call_Statement);
-- return Flag17 (N);
-- end Parameter_List_Truncated;
--
- function Parameter_Specifications
- (N : Node_Id) return List_Id is
- begin
-@@ -4257,15 +4247,6 @@ package body Sinfo is
- Set_Flag4 (N, Val);
- end Set_Elaborate_Present;
-
-- procedure Set_Elaboration_Boolean
-- (N : Node_Id; Val : Node_Id) is
-- begin
-- pragma Assert (False
-- or else NT (N).Nkind = N_Function_Specification
-- or else NT (N).Nkind = N_Procedure_Specification);
-- Set_Node2 (N, Val);
-- end Set_Elaboration_Boolean;
--
- procedure Set_Else_Actions
- (N : Node_Id; Val : List_Id) is
- begin
-@@ -5105,6 +5086,14 @@ package body Sinfo is
- Set_Flag11 (N, Val);
- end Set_Is_In_Discriminant_Check;
-
-+ procedure Set_Is_Inherited
-+ (N : Node_Id; Val : Boolean := True) is
-+ begin
-+ pragma Assert (False
-+ or else NT (N).Nkind = N_Pragma);
-+ Set_Flag4 (N, Val);
-+ end Set_Is_Inherited;
-+
- procedure Set_Is_Machine_Number
- (N : Node_Id; Val : Boolean := True) is
- begin
-@@ -5695,15 +5684,6 @@ package body Sinfo is
- Set_List3_With_Parent (N, Val);
- end Set_Parameter_Associations;
-
-- procedure Set_Parameter_List_Truncated
-- (N : Node_Id; Val : Boolean := True) is
-- begin
-- pragma Assert (False
-- or else NT (N).Nkind = N_Function_Call
-- or else NT (N).Nkind = N_Procedure_Call_Statement);
-- Set_Flag17 (N, Val);
-- end Set_Parameter_List_Truncated;
--
- procedure Set_Parameter_Specifications
- (N : Node_Id; Val : List_Id) is
- begin
-diff --git a/gnat/sinfo.ads b/gnat/sinfo.ads
-index 7639cee..7c4bbf9 100644
---- a/gnat/sinfo.ads
-+++ b/gnat/sinfo.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -521,6 +521,32 @@ package Sinfo is
- -- simply ignore these nodes, since they are not relevant to the task
- -- of back annotating representation information.
-
-+ ----------------
-+ -- Ghost Mode --
-+ ----------------
-+
-+ -- When a declaration is subject to pragma Ghost, it establishes a Ghost
-+ -- region depending on the Ghost assertion policy in effect at the point
-+ -- of declaration. This region is temporal and starts right before the
-+ -- analysis of the Ghost declaration and ends after its expansion. The
-+ -- values of global variable Opt.Ghost_Mode are as follows:
-+
-+ -- 1. Check - All static semantics as defined in SPARK RM 6.9 are in
-+ -- effect.
-+
-+ -- 2. Ignore - Same as Check, ignored Ghost code is not present in ALI
-+ -- files, object files as well as the final executable.
-+
-+ -- To achieve the runtime semantics of "Ignore", the compiler marks each
-+ -- node created during an ignored Ghost region and signals all enclosing
-+ -- scopes that such a node resides within. The compilation unit where the
-+ -- node resides is also added to an auxiliary table for post processing.
-+
-+ -- After the analysis and expansion of all compilation units takes place
-+ -- as well as the instantiation of all inlined [generic] bodies, the GNAT
-+ -- driver initiates a separate pass which removes all ignored Ghost code
-+ -- from all units stored in the auxiliary table.
-+
- --------------------
- -- GNATprove Mode --
- --------------------
-@@ -562,7 +588,7 @@ package Sinfo is
- -- not make sense from a user point-of-view, and that cross-references that
- -- do not lead to data dependences for subprograms can be safely ignored.
-
-- -- GNATprove relies on the following frontend behaviors:
-+ -- GNATprove relies on the following front end behaviors:
-
- -- 1. The first declarations in the list of visible declarations of
- -- a package declaration for a generic instance, up to the first
-@@ -577,6 +603,20 @@ package Sinfo is
- -- warning issued when generating code, to avoid formal verification
- -- of a partial unit.
-
-+ -- 4. Unconstrained types are not replaced by constrained types whose
-+ -- bounds are generated from an expression: Expand_Subtype_From_Expr
-+ -- should be a no-op.
-+
-+ -- 5. Errors (instead of warnings) are issued on compile-time-known
-+ -- constraint errors even though such cases do not correspond to
-+ -- illegalities in the Ada RM (this is simply another case where
-+ -- GNATprove implements a subset of the full language).
-+ --
-+ -- However, there are a few exceptions to this rule for cases where
-+ -- we want to allow the GNATprove analysis to proceed (e.g. range
-+ -- checks on empty ranges, which typically appear in deactivated
-+ -- code in a particular configuration).
-+
- -----------------------
- -- Check Flag Fields --
- -----------------------
-@@ -1061,7 +1101,9 @@ package Sinfo is
- -- Initialization expression for the initial value in an object
- -- declaration. In this case the Do_Range_Check flag is set on
- -- the initialization expression, and the check is against the
-- -- range of the type of the object being declared.
-+ -- range of the type of the object being declared. This includes the
-+ -- cases of expressions providing default discriminant values, and
-+ -- expressions used to initialize record components.
-
- -- The expression of a type conversion. In this case the range check is
- -- against the target type of the conversion. See also the use of
-@@ -1087,7 +1129,7 @@ package Sinfo is
- -- Do_Storage_Check (Flag17-Sem)
- -- This flag is set in an N_Allocator node to indicate that a storage
- -- check is required for the allocation, or in an N_Subprogram_Body node
-- -- to indicate that a stack check is required in the subprogram prolog.
-+ -- to indicate that a stack check is required in the subprogram prologue.
- -- The N_Allocator case is handled by the routine that expands the call
- -- to the runtime routine. The N_Subprogram_Body case is handled by the
- -- backend, and all the semantics does is set the flag.
-@@ -1117,13 +1159,6 @@ package Sinfo is
- -- elaboration processing has determined that an Elaborate pragma is
- -- desirable for correct elaboration for this unit.
-
-- -- Elaboration_Boolean (Node2-Sem)
-- -- This field is present in function and procedure specification nodes.
-- -- If set, it points to the entity for a Boolean flag that must be tested
-- -- for certain calls to check for access before elaboration. See body of
-- -- Sem_Elab for further details. This field is Empty if no elaboration
-- -- boolean is required.
--
- -- Else_Actions (List3-Sem)
- -- This field is present in if expression nodes. During code
- -- expansion we use the Insert_Actions procedure (in Exp_Util) to insert
-@@ -1259,8 +1294,6 @@ package Sinfo is
- -- Float_Truncate (Flag11-Sem)
- -- A flag present in type conversion nodes. This is used for float to
- -- integer conversions where truncation is required rather than rounding.
-- -- Note that Gigi does not handle type conversions from real to integer
-- -- with rounding (see Expand_N_Type_Conversion).
-
- -- Forwards_OK (Flag5-Sem)
- -- A flag present in the N_Assignment_Statement node. It is used only
-@@ -1576,6 +1609,10 @@ package Sinfo is
- -- discriminant check has a correct value cannot be performed in this
- -- case (or the discriminant check may be optimized away).
-
-+ -- Is_Inherited (Flag4-Sem)
-+ -- This flag is set in an N_Pragma node that appears in a N_Contract node
-+ -- to indicate that the pragma has been inherited from a parent context.
-+
- -- Is_Machine_Number (Flag11-Sem)
- -- This flag is set in an N_Real_Literal node to indicate that the value
- -- is a machine number. This avoids some unnecessary cases of converting
-@@ -1625,7 +1662,7 @@ package Sinfo is
- -- when Raises_Constraint_Error is also set. In practice almost all cases
- -- where a static expression is required do not allow an expression which
- -- raises Constraint_Error, so almost always, callers should call the
-- -- Is_Ok_Static_Exprression routine instead of testing this flag. See
-+ -- Is_Ok_Static_Expression routine instead of testing this flag. See
- -- spec of package Sem_Eval for full details on the use of this flag.
-
- -- Is_Subprogram_Descriptor (Flag16-Sem)
-@@ -1685,6 +1722,8 @@ package Sinfo is
- --
- -- For a subunit, Library_Unit points to the compilation unit node of
- -- the parent body.
-+ -- ??? not (always) true, in (at least some, maybe all?) cases it points
-+ -- to the corresponding spec for the parent body.
- --
- -- Note that this field is not used to hold the parent pointer for child
- -- unit (which might in any case need to use it for some other purpose as
-@@ -1888,21 +1927,6 @@ package Sinfo is
- -- list of discrete choices, except that of course it cannot contain an
- -- N_Others_Choice entry.
-
-- -- Parameter_List_Truncated (Flag17-Sem)
-- -- Present in N_Function_Call and N_Procedure_Call_Statement nodes. Set
-- -- (for OpenVMS ports of GNAT only) if the parameter list is truncated
-- -- as a result of a First_Optional_Parameter specification in one of the
-- -- pragmas Import_Function, Import_Procedure, or Import_Valued_Procedure.
-- -- The truncation is done by the expander by removing trailing parameters
-- -- from the argument list, in accordance with the set of rules allowing
-- -- such parameter removal. In particular, parameters can be removed
-- -- working from the end of the parameter list backwards up to and
-- -- including the entry designated by First_Optional_Parameter in the
-- -- Import pragma. Parameters can be removed if they are implicit and the
-- -- default value is known at compile time value, including the use of
-- -- the Null_Parameter attribute, or if explicit parameter values are
-- -- present that match the corresponding defaults.
--
- -- Parent_Spec (Node4-Sem)
- -- For a library unit that is a child unit spec (package or subprogram
- -- declaration, generic declaration or instantiation, or library level
-@@ -2400,11 +2424,12 @@ package Sinfo is
- -- Next_Rep_Item (Node5-Sem)
- -- Class_Present (Flag6) set if from Aspect with 'Class
- -- From_Aspect_Specification (Flag13-Sem)
-+ -- Import_Interface_Present (Flag16-Sem)
-+ -- Is_Checked (Flag11-Sem)
- -- Is_Delayed_Aspect (Flag14-Sem)
- -- Is_Disabled (Flag15-Sem)
- -- Is_Ignored (Flag9-Sem)
-- -- Is_Checked (Flag11-Sem)
-- -- Import_Interface_Present (Flag16-Sem)
-+ -- Is_Inherited (Flag4-Sem)
- -- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set
- -- Uneval_Old_Accept (Flag7-Sem)
- -- Uneval_Old_Warn (Flag18-Sem)
-@@ -4255,6 +4280,11 @@ package Sinfo is
- -- point operands if the Treat_Fixed_As_Integer flag is set and will
- -- thus treat these nodes in identical manner, ignoring small values.
-
-+ -- Note on equality/inequality tests for records. In the expanded tree,
-+ -- record comparisons are always expanded to be a series of component
-+ -- comparisons, so the back end will never see an equality or inequality
-+ -- operation with operands of a record type.
-+
- -- Note on overflow handling: When the overflow checking mode is set to
- -- MINIMIZED or ELIMINATED, nodes for signed arithmetic operations may
- -- be modified to use a larger type for the operands and result. In
-@@ -4899,7 +4929,6 @@ package Sinfo is
- -- N_Function_Specification
- -- Sloc points to FUNCTION
- -- Defining_Unit_Name (Node1) (the designator)
-- -- Elaboration_Boolean (Node2-Sem)
- -- Parameter_Specifications (List3) (set to No_List if no formal part)
- -- Null_Exclusion_Present (Flag11)
- -- Result_Definition (Node4) for result subtype
-@@ -4910,7 +4939,6 @@ package Sinfo is
- -- N_Procedure_Specification
- -- Sloc points to PROCEDURE
- -- Defining_Unit_Name (Node1)
-- -- Elaboration_Boolean (Node2-Sem)
- -- Parameter_Specifications (List3) (set to No_List if no formal part)
- -- Generic_Parent (Node5-Sem)
- -- Null_Present (Flag13) set for null procedure case (Ada 2005 feature)
-@@ -5156,7 +5184,6 @@ package Sinfo is
- -- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
- -- Do_Tag_Check (Flag13-Sem)
- -- No_Elaboration_Check (Flag14-Sem)
-- -- Parameter_List_Truncated (Flag17-Sem)
- -- ABE_Is_Certain (Flag18-Sem)
- -- plus fields for expression
-
-@@ -5188,7 +5215,6 @@ package Sinfo is
- -- Is_Expanded_Build_In_Place_Call (Flag11-Sem)
- -- Do_Tag_Check (Flag13-Sem)
- -- No_Elaboration_Check (Flag14-Sem)
-- -- Parameter_List_Truncated (Flag17-Sem)
- -- ABE_Is_Certain (Flag18-Sem)
- -- plus fields for expression
-
-@@ -8969,9 +8995,6 @@ package Sinfo is
- function Elaborate_Present
- (N : Node_Id) return Boolean; -- Flag4
-
-- function Elaboration_Boolean
-- (N : Node_Id) return Node_Id; -- Node2
--
- function Else_Actions
- (N : Node_Id) return List_Id; -- List3
-
-@@ -9247,6 +9270,9 @@ package Sinfo is
- function Is_In_Discriminant_Check
- (N : Node_Id) return Boolean; -- Flag11
-
-+ function Is_Inherited
-+ (N : Node_Id) return Boolean; -- Flag4
-+
- function Is_Machine_Number
- (N : Node_Id) return Boolean; -- Flag11
-
-@@ -9433,9 +9459,6 @@ package Sinfo is
- function Parameter_Associations
- (N : Node_Id) return List_Id; -- List3
-
-- function Parameter_List_Truncated
-- (N : Node_Id) return Boolean; -- Flag17
--
- function Parameter_Specifications
- (N : Node_Id) return List_Id; -- List3
-
-@@ -9994,9 +10017,6 @@ package Sinfo is
- procedure Set_Elaborate_Present
- (N : Node_Id; Val : Boolean := True); -- Flag4
-
-- procedure Set_Elaboration_Boolean
-- (N : Node_Id; Val : Node_Id); -- Node2
--
- procedure Set_Else_Actions
- (N : Node_Id; Val : List_Id); -- List3
-
-@@ -10270,6 +10290,9 @@ package Sinfo is
- procedure Set_Is_In_Discriminant_Check
- (N : Node_Id; Val : Boolean := True); -- Flag11
-
-+ procedure Set_Is_Inherited
-+ (N : Node_Id; Val : Boolean := True); -- Flag4
-+
- procedure Set_Is_Machine_Number
- (N : Node_Id; Val : Boolean := True); -- Flag11
-
-@@ -10456,9 +10479,6 @@ package Sinfo is
- procedure Set_Parameter_Associations
- (N : Node_Id; Val : List_Id); -- List3
-
-- procedure Set_Parameter_List_Truncated
-- (N : Node_Id; Val : Boolean := True); -- Flag17
--
- procedure Set_Parameter_Specifications
- (N : Node_Id; Val : List_Id); -- List3
-
-@@ -11522,14 +11542,14 @@ package Sinfo is
-
- N_Function_Specification =>
- (1 => True, -- Defining_Unit_Name (Node1)
-- 2 => False, -- Elaboration_Boolean (Node2-Sem)
-+ 2 => False, -- unused
- 3 => True, -- Parameter_Specifications (List3)
- 4 => True, -- Result_Definition (Node4)
- 5 => False), -- Generic_Parent (Node5-Sem)
-
- N_Procedure_Specification =>
- (1 => True, -- Defining_Unit_Name (Node1)
-- 2 => False, -- Elaboration_Boolean (Node2-Sem)
-+ 2 => False, -- unused
- 3 => True, -- Parameter_Specifications (List3)
- 4 => False, -- unused
- 5 => False), -- Generic_Parent (Node5-Sem)
-@@ -12563,7 +12583,6 @@ package Sinfo is
- pragma Inline (Elaborate_All_Desirable);
- pragma Inline (Elaborate_All_Present);
- pragma Inline (Elaborate_Desirable);
-- pragma Inline (Elaboration_Boolean);
- pragma Inline (Else_Actions);
- pragma Inline (Else_Statements);
- pragma Inline (Elsif_Parts);
-@@ -12657,6 +12676,7 @@ package Sinfo is
- pragma Inline (Is_Folded_In_Parser);
- pragma Inline (Is_Ignored);
- pragma Inline (Is_In_Discriminant_Check);
-+ pragma Inline (Is_Inherited);
- pragma Inline (Is_Machine_Number);
- pragma Inline (Is_Null_Loop);
- pragma Inline (Is_Overloaded);
-@@ -12719,7 +12739,6 @@ package Sinfo is
- pragma Inline (Out_Present);
- pragma Inline (Parameter_Associations);
- pragma Inline (Parameter_Specifications);
-- pragma Inline (Parameter_List_Truncated);
- pragma Inline (Parameter_Type);
- pragma Inline (Parent_Spec);
- pragma Inline (Position);
-@@ -12902,7 +12921,6 @@ package Sinfo is
- pragma Inline (Set_Elaborate_All_Present);
- pragma Inline (Set_Elaborate_Desirable);
- pragma Inline (Set_Elaborate_Present);
-- pragma Inline (Set_Elaboration_Boolean);
- pragma Inline (Set_Else_Actions);
- pragma Inline (Set_Else_Statements);
- pragma Inline (Set_Elsif_Parts);
-@@ -12993,6 +13011,7 @@ package Sinfo is
- pragma Inline (Set_Is_Folded_In_Parser);
- pragma Inline (Set_Is_Ignored);
- pragma Inline (Set_Is_In_Discriminant_Check);
-+ pragma Inline (Set_Is_Inherited);
- pragma Inline (Set_Is_Machine_Number);
- pragma Inline (Set_Is_Null_Loop);
- pragma Inline (Set_Is_Overloaded);
-@@ -13055,7 +13074,6 @@ package Sinfo is
- pragma Inline (Set_Others_Discrete_Choices);
- pragma Inline (Set_Out_Present);
- pragma Inline (Set_Parameter_Associations);
-- pragma Inline (Set_Parameter_List_Truncated);
- pragma Inline (Set_Parameter_Specifications);
- pragma Inline (Set_Parameter_Type);
- pragma Inline (Set_Parent_Spec);
-diff --git a/gnat/sinput-c.adb b/gnat/sinput-c.adb
-index 06c501b..6c3d582 100644
---- a/gnat/sinput-c.adb
-+++ b/gnat/sinput-c.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -92,8 +92,8 @@ package body Sinput.C is
-
- Len := Integer (File_Length (Source_File_FD));
-
-- -- Set Hi so that length is one more than the physical length,
-- -- allowing for the extra EOF character at the end of the buffer
-+ -- Set Hi so that length is one more than the physical length, allowing
-+ -- for the extra EOF character at the end of the buffer
-
- Hi := Lo + Source_Ptr (Len);
-
-@@ -112,9 +112,9 @@ package body Sinput.C is
- begin
- -- Allocate source buffer, allowing extra character at end for EOF
-
-- -- Some systems (e.g. VMS) have file types that require one
-- -- read per line, so read until we get the Len bytes or until
-- -- there are no more characters.
-+ -- Some systems have file types that require one read per line,
-+ -- so read until we get the Len bytes or until there are no more
-+ -- characters.
-
- Hi := Lo;
- loop
-@@ -126,8 +126,8 @@ package body Sinput.C is
- Actual_Ptr (Hi) := EOF;
-
- -- Now we need to work out the proper virtual origin pointer to
-- -- return. This is exactly Actual_Ptr (0)'Address, but we have
-- -- to be careful to suppress checks to compute this address.
-+ -- return. This is exactly Actual_Ptr (0)'Address, but we have to
-+ -- be careful to suppress checks to compute this address.
-
- declare
- pragma Suppress (All_Checks);
-diff --git a/gnat/sinput.adb b/gnat/sinput.adb
-index fa3bb0a..1c8232d 100644
---- a/gnat/sinput.adb
-+++ b/gnat/sinput.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -302,6 +302,17 @@ package body Sinput is
- end case;
- end Check_For_BOM;
-
-+ -----------------------------
-+ -- Comes_From_Inlined_Body --
-+ -----------------------------
-+
-+ function Comes_From_Inlined_Body (S : Source_Ptr) return Boolean is
-+ SIE : Source_File_Record renames
-+ Source_File.Table (Get_Source_File_Index (S));
-+ begin
-+ return SIE.Inlined_Body;
-+ end Comes_From_Inlined_Body;
-+
- -----------------------
- -- Get_Column_Number --
- -----------------------
-diff --git a/gnat/sinput.ads b/gnat/sinput.ads
-index 85bff08..3d36903 100644
---- a/gnat/sinput.ads
-+++ b/gnat/sinput.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -638,6 +638,13 @@ package Sinput is
- -- value of the instantiation if this location is within an instance.
- -- If S is not within an instance, then this returns No_Location.
-
-+ function Comes_From_Inlined_Body (S : Source_Ptr) return Boolean;
-+ pragma Inline (Comes_From_Inlined_Body);
-+ -- Given a source pointer S, returns whether it comes from an inlined body.
-+ -- This allows distinguishing these source pointers from those that come
-+ -- from instantiation of generics, since Instantiation_Location returns a
-+ -- valid location in both cases.
-+
- function Top_Level_Location (S : Source_Ptr) return Source_Ptr;
- -- Given a source pointer S, returns the argument unchanged if it is
- -- not in an instantiation. If S is in an instantiation, then it returns
-diff --git a/gnat/snames.adb-tmpl b/gnat/snames.adb-tmpl
-index a970675..6e1acd9 100644
---- a/gnat/snames.adb-tmpl
-+++ b/gnat/snames.adb-tmpl
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -29,6 +29,7 @@
- -- --
- ------------------------------------------------------------------------------
-
-+with Debug; use Debug;
- with Opt; use Opt;
- with Table;
- with Types; use Types;
-@@ -155,7 +156,6 @@ package body Snames is
- when Name_COBOL => return Convention_COBOL;
- when Name_CPP => return Convention_CPP;
- when Name_Fortran => return Convention_Fortran;
-- when Name_Ghost => return Convention_Ghost;
- when Name_Intrinsic => return Convention_Intrinsic;
- when Name_Java => return Convention_Java;
- when Name_Stdcall => return Convention_Stdcall;
-@@ -193,7 +193,6 @@ package body Snames is
- when Convention_CPP => return Name_CPP;
- when Convention_Entry => return Name_Entry;
- when Convention_Fortran => return Name_Fortran;
-- when Convention_Ghost => return Name_Ghost;
- when Convention_Intrinsic => return Name_Intrinsic;
- when Convention_Java => return Name_Java;
- when Convention_Protected => return Name_Protected;
-@@ -217,33 +216,32 @@ package body Snames is
-
- function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
- begin
-- if N = Name_AST_Entry then
-- return Pragma_AST_Entry;
-- elsif N = Name_CPU then
-- return Pragma_CPU;
-- elsif N = Name_Dispatching_Domain then
-- return Pragma_Dispatching_Domain;
-- elsif N = Name_Fast_Math then
-- return Pragma_Fast_Math;
-- elsif N = Name_Interface then
-- return Pragma_Interface;
-- elsif N = Name_Interrupt_Priority then
-- return Pragma_Interrupt_Priority;
-- elsif N = Name_Lock_Free then
-- return Pragma_Lock_Free;
-- elsif N = Name_Priority then
-- return Pragma_Priority;
-- elsif N = Name_Relative_Deadline then
-- return Pragma_Relative_Deadline;
-- elsif N = Name_Storage_Size then
-- return Pragma_Storage_Size;
-- elsif N = Name_Storage_Unit then
-- return Pragma_Storage_Unit;
-- elsif N not in First_Pragma_Name .. Last_Pragma_Name then
-- return Unknown_Pragma;
-- else
-- return Pragma_Id'Val (N - First_Pragma_Name);
-- end if;
-+ case N is
-+ when Name_CPU =>
-+ return Pragma_CPU;
-+ when Name_Default_Scalar_Storage_Order =>
-+ return Pragma_Default_Scalar_Storage_Order;
-+ when Name_Dispatching_Domain =>
-+ return Pragma_Dispatching_Domain;
-+ when Name_Fast_Math =>
-+ return Pragma_Fast_Math;
-+ when Name_Interface =>
-+ return Pragma_Interface;
-+ when Name_Interrupt_Priority =>
-+ return Pragma_Interrupt_Priority;
-+ when Name_Lock_Free =>
-+ return Pragma_Lock_Free;
-+ when Name_Priority =>
-+ return Pragma_Priority;
-+ when Name_Storage_Size =>
-+ return Pragma_Storage_Size;
-+ when Name_Storage_Unit =>
-+ return Pragma_Storage_Unit;
-+ when First_Pragma_Name .. Last_Pragma_Name =>
-+ return Pragma_Id'Val (N - First_Pragma_Name);
-+ when others =>
-+ return Unknown_Pragma;
-+ end case;
- end Get_Pragma_Id;
-
- ---------------------------
-@@ -338,6 +336,7 @@ package body Snames is
- function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean is
- begin
- return N in First_Pragma_Name .. Last_Configuration_Pragma_Name
-+ or else N = Name_Default_Scalar_Storage_Order
- or else N = Name_Fast_Math;
- end Is_Configuration_Pragma_Name;
-
-@@ -397,7 +396,11 @@ package body Snames is
- and then (Ada_Version >= Ada_95
- or else N not in Ada_95_Reserved_Words)
- and then (Ada_Version >= Ada_2005
-- or else N not in Ada_2005_Reserved_Words)
-+ or else N not in Ada_2005_Reserved_Words
-+ or else (Debug_Flag_Dot_DD and then N = Name_Overriding))
-+ -- Accept 'overriding' keywords if -gnatd.D is used,
-+ -- for compatibility with Ada 95 compilers implementing
-+ -- only this Ada 2005 extension.
- and then (Ada_Version >= Ada_2012
- or else N not in Ada_2012_Reserved_Words);
- end Is_Keyword_Name;
-@@ -449,8 +452,8 @@ package body Snames is
- function Is_Pragma_Name (N : Name_Id) return Boolean is
- begin
- return N in First_Pragma_Name .. Last_Pragma_Name
-- or else N = Name_AST_Entry
- or else N = Name_CPU
-+ or else N = Name_Default_Scalar_Storage_Order
- or else N = Name_Dispatching_Domain
- or else N = Name_Fast_Math
- or else N = Name_Interface
-diff --git a/gnat/snames.ads-tmpl b/gnat/snames.ads-tmpl
-index 516519a..47a8ccd 100644
---- a/gnat/snames.ads-tmpl
-+++ b/gnat/snames.ads-tmpl
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -329,7 +329,7 @@ package Snames is
- -- to be implementation dependent pragmas.
-
- -- The entries marked GNAT are pragmas that are defined by GNAT and that
-- -- are implemented in all modes (Ada 83, Ada 95, and Ada 2005) Complete
-+ -- are implemented in all modes (Ada 83, Ada 95, and Ada 2005). Complete
- -- descriptions of the syntax of these implementation dependent pragmas may
- -- be found in the appropriate section in unit Sem_Prag in file
- -- sem-prag.adb, and they are documented in the GNAT reference manual.
-@@ -342,10 +342,6 @@ package Snames is
- -- Ada 83, Ada 95, and Ada 2005 mode as well, where they are technically
- -- considered to be implementation dependent pragmas.
-
-- -- The entries marked VMS are VMS specific pragmas that are recognized only
-- -- in OpenVMS versions of GNAT. They are ignored in other versions with an
-- -- appropriate warning.
--
- -- The entries marked AAMP are AAMP specific pragmas that are recognized
- -- only in GNAT for the AAMP. They are ignored in other versions with
- -- appropriate warnings.
-@@ -380,7 +376,6 @@ package Snames is
- Name_Convention_Identifier : constant Name_Id := N + $; -- GNAT
- Name_Debug_Policy : constant Name_Id := N + $; -- GNAT
- Name_Detect_Blocking : constant Name_Id := N + $; -- Ada 05
-- Name_Default_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
- Name_Default_Storage_Pool : constant Name_Id := N + $; -- Ada 12
- Name_Disable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT
- Name_Discard_Names : constant Name_Id := N + $;
-@@ -405,16 +400,15 @@ package Snames is
- -- Fast_Math.
-
- Name_Favor_Top_Level : constant Name_Id := N + $; -- GNAT
-- Name_Float_Representation : constant Name_Id := N + $; -- GNAT
- Name_Implicit_Packing : constant Name_Id := N + $; -- GNAT
- Name_Initialize_Scalars : constant Name_Id := N + $; -- GNAT
- Name_Interrupt_State : constant Name_Id := N + $; -- GNAT
- Name_License : constant Name_Id := N + $; -- GNAT
- Name_Locking_Policy : constant Name_Id := N + $;
-- Name_Long_Float : constant Name_Id := N + $; -- VMS
- Name_Loop_Optimize : constant Name_Id := N + $; -- GNAT
- Name_No_Run_Time : constant Name_Id := N + $; -- GNAT
- Name_No_Strict_Aliasing : constant Name_Id := N + $; -- GNAT
-+ Name_No_Tagged_Streams : constant Name_Id := N + $; -- GNAT
- Name_Normalize_Scalars : constant Name_Id := N + $;
- Name_Optimize_Alignment : constant Name_Id := N + $; -- GNAT
- Name_Overflow_Mode : constant Name_Id := N + $; -- GNAT
-@@ -422,6 +416,7 @@ package Snames is
- Name_Partition_Elaboration_Policy : constant Name_Id := N + $; -- Ada 05
- Name_Persistent_BSS : constant Name_Id := N + $; -- GNAT
- Name_Polling : constant Name_Id := N + $; -- GNAT
-+ Name_Prefix_Exception_Messages : constant Name_Id := N + $; -- GNAT
- Name_Priority_Specific_Dispatching : constant Name_Id := N + $; -- Ada 05
- Name_Profile : constant Name_Id := N + $; -- Ada 05
- Name_Profile_Warnings : constant Name_Id := N + $; -- GNAT
-@@ -457,12 +452,6 @@ package Snames is
- Name_Abort_Defer : constant Name_Id := N + $; -- GNAT
- Name_Abstract_State : constant Name_Id := N + $; -- GNAT
- Name_All_Calls_Remote : constant Name_Id := N + $;
--
-- -- Note: AST_Entry is not in this list because its name matches the name of
-- -- the corresponding attribute. However, it is included in the definition
-- -- of the type Pragma_Id, and the functions Get_Pragma_Id and Is_Pragma_Id
-- -- correctly recognize and process Name_AST_Entry.
--
- Name_Assert : constant Name_Id := N + $; -- Ada 05
- Name_Assert_And_Cut : constant Name_Id := N + $; -- GNAT
- Name_Async_Readers : constant Name_Id := N + $; -- GNAT
-@@ -492,6 +481,7 @@ package Snames is
- -- pragma.
-
- Name_Debug : constant Name_Id := N + $; -- GNAT
-+ Name_Default_Initial_Condition : constant Name_Id := N + $; -- GNAT
- Name_Depends : constant Name_Id := N + $; -- GNAT
- Name_Effective_Reads : constant Name_Id := N + $; -- GNAT
- Name_Effective_Writes : constant Name_Id := N + $; -- GNAT
-@@ -499,20 +489,20 @@ package Snames is
- Name_Elaborate_All : constant Name_Id := N + $;
- Name_Elaborate_Body : constant Name_Id := N + $;
- Name_Export : constant Name_Id := N + $;
-- Name_Export_Exception : constant Name_Id := N + $; -- VMS
- Name_Export_Function : constant Name_Id := N + $; -- GNAT
- Name_Export_Object : constant Name_Id := N + $; -- GNAT
- Name_Export_Procedure : constant Name_Id := N + $; -- GNAT
- Name_Export_Value : constant Name_Id := N + $; -- GNAT
- Name_Export_Valued_Procedure : constant Name_Id := N + $; -- GNAT
-+ Name_Extensions_Visible : constant Name_Id := N + $; -- GNAT
- Name_External : constant Name_Id := N + $; -- GNAT
- Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT
-+ Name_Ghost : constant Name_Id := N + $; -- GNAT
- Name_Global : constant Name_Id := N + $; -- GNAT
-- Name_Ident : constant Name_Id := N + $; -- VMS
-+ Name_Ident : constant Name_Id := N + $; -- GNAT
- Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT
- Name_Implemented : constant Name_Id := N + $; -- Ada 12
- Name_Import : constant Name_Id := N + $;
-- Name_Import_Exception : constant Name_Id := N + $; -- VMS
- Name_Import_Function : constant Name_Id := N + $; -- GNAT
- Name_Import_Object : constant Name_Id := N + $; -- GNAT
- Name_Import_Procedure : constant Name_Id := N + $; -- GNAT
-@@ -563,6 +553,7 @@ package Snames is
- Name_Main_Storage : constant Name_Id := N + $; -- GNAT
- Name_Memory_Size : constant Name_Id := N + $; -- Ada 83
- Name_No_Body : constant Name_Id := N + $; -- GNAT
-+ Name_No_Elaboration_Code_All : constant Name_Id := N + $; -- GNAT
- Name_No_Inline : constant Name_Id := N + $; -- GNAT
- Name_No_Return : constant Name_Id := N + $; -- Ada 05
- Name_Obsolescent : constant Name_Id := N + $; -- GNAT
-@@ -589,7 +580,7 @@ package Snames is
- -- pragma.
-
- Name_Provide_Shift_Operators : constant Name_Id := N + $; -- GNAT
-- Name_Psect_Object : constant Name_Id := N + $; -- VMS
-+ Name_Psect_Object : constant Name_Id := N + $; -- GNAT
- Name_Pure : constant Name_Id := N + $;
- Name_Pure_Function : constant Name_Id := N + $; -- GNAT
- Name_Refined_Depends : constant Name_Id := N + $; -- GNAT
-@@ -624,7 +615,7 @@ package Snames is
- Name_Test_Case : constant Name_Id := N + $; -- GNAT
- Name_Task_Info : constant Name_Id := N + $; -- GNAT
- Name_Task_Name : constant Name_Id := N + $; -- GNAT
-- Name_Task_Storage : constant Name_Id := N + $; -- VMS
-+ Name_Task_Storage : constant Name_Id := N + $; -- GNAT
- Name_Thread_Local_Storage : constant Name_Id := N + $; -- GNAT
- Name_Time_Slice : constant Name_Id := N + $; -- GNAT
- Name_Title : constant Name_Id := N + $; -- GNAT
-@@ -660,7 +651,6 @@ package Snames is
- Name_COBOL : constant Name_Id := N + $;
- Name_CPP : constant Name_Id := N + $;
- Name_Fortran : constant Name_Id := N + $;
-- Name_Ghost : constant Name_Id := N + $;
- Name_Intrinsic : constant Name_Id := N + $;
- Name_Java : constant Name_Id := N + $;
- Name_Stdcall : constant Name_Id := N + $;
-@@ -686,11 +676,12 @@ package Snames is
- Name_DLL : constant Name_Id := N + $;
- Name_Win32 : constant Name_Id := N + $;
-
-- -- Other special names used in processing pragmas
-+ -- Other special names used in processing attributes and pragmas
-
- Name_Allow : constant Name_Id := N + $;
- Name_Amount : constant Name_Id := N + $;
- Name_As_Is : constant Name_Id := N + $;
-+ Name_Attr_Long_Float : constant Name_Id := N + $;
- Name_Assertion : constant Name_Id := N + $;
- Name_Assertions : constant Name_Id := N + $;
- Name_Attribute_Name : constant Name_Id := N + $;
-@@ -707,7 +698,6 @@ package Snames is
- Name_Copy : constant Name_Id := N + $;
- Name_D_Float : constant Name_Id := N + $;
- Name_Decreases : constant Name_Id := N + $;
-- Name_Descriptor : constant Name_Id := N + $;
- Name_Disable : constant Name_Id := N + $;
- Name_Dot_Replacement : constant Name_Id := N + $;
- Name_Dynamic : constant Name_Id := N + $;
-@@ -723,6 +713,7 @@ package Snames is
- Name_Gcc : constant Name_Id := N + $;
- Name_General : constant Name_Id := N + $;
- Name_Gnat : constant Name_Id := N + $;
-+ Name_Gnatprove : constant Name_Id := N + $;
- Name_GPL : constant Name_Id := N + $;
- Name_High_Order_First : constant Name_Id := N + $;
- Name_IEEE_Float : constant Name_Id := N + $;
-@@ -752,6 +743,7 @@ package Snames is
- Name_No_Dependence : constant Name_Id := N + $;
- Name_No_Dynamic_Attachment : constant Name_Id := N + $;
- Name_No_Dynamic_Interrupts : constant Name_Id := N + $;
-+ Name_No_Elaboration_Code : constant Name_Id := N + $;
- Name_No_Implementation_Extensions : constant Name_Id := N + $;
- Name_No_Obsolescent_Features : constant Name_Id := N + $;
- Name_No_Requeue : constant Name_Id := N + $;
-@@ -761,6 +753,7 @@ package Snames is
- Name_No_Task_Attributes : constant Name_Id := N + $;
- Name_No_Task_Attributes_Package : constant Name_Id := N + $;
- Name_No_Use_Of_Attribute : constant Name_Id := N + $;
-+ Name_No_Use_Of_Entity : constant Name_Id := N + $;
- Name_No_Use_Of_Pragma : constant Name_Id := N + $;
- Name_No_Unroll : constant Name_Id := N + $;
- Name_No_Vector : constant Name_Id := N + $;
-@@ -783,7 +776,6 @@ package Snames is
- Name_Secondary_Stack_Size : constant Name_Id := N + $;
- Name_Section : constant Name_Id := N + $;
- Name_Semaphore : constant Name_Id := N + $;
-- Name_Short_Descriptor : constant Name_Id := N + $;
- Name_Simple_Barriers : constant Name_Id := N + $;
- Name_SPARK : constant Name_Id := N + $;
- Name_SPARK_05 : constant Name_Id := N + $;
-@@ -811,7 +803,6 @@ package Snames is
- Name_Variant : constant Name_Id := N + $;
- Name_VAX_Float : constant Name_Id := N + $;
- Name_Vector : constant Name_Id := N + $;
-- Name_VMS : constant Name_Id := N + $;
- Name_Vtable_Ptr : constant Name_Id := N + $;
- Name_Warn : constant Name_Id := N + $;
- Name_Working_Storage : constant Name_Id := N + $;
-@@ -824,9 +815,6 @@ package Snames is
- -- implemented in all Ada modes. Full descriptions of these implementation
- -- dependent attributes may be found in the appropriate Sem_Attr section.
-
-- -- The entries marked VMS are recognized only in OpenVMS implementations
-- -- of GNAT, and are treated as illegal in all other contexts.
--
- First_Attribute_Name : constant Name_Id := N + $;
- Name_Abort_Signal : constant Name_Id := N + $; -- GNAT
- Name_Access : constant Name_Id := N + $;
-@@ -836,7 +824,6 @@ package Snames is
- Name_Alignment : constant Name_Id := N + $;
- Name_Asm_Input : constant Name_Id := N + $; -- GNAT
- Name_Asm_Output : constant Name_Id := N + $; -- GNAT
-- Name_AST_Entry : constant Name_Id := N + $; -- VMS
- Name_Atomic_Always_Lock_Free : constant Name_Id := N + $; -- GNAT
- Name_Bit : constant Name_Id := N + $; -- GNAT
- Name_Bit_Order : constant Name_Id := N + $;
-@@ -852,6 +839,7 @@ package Snames is
- Name_Constrained : constant Name_Id := N + $;
- Name_Count : constant Name_Id := N + $;
- Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT
-+ Name_Default_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
- Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
- Name_Definite : constant Name_Id := N + $;
- Name_Delta : constant Name_Id := N + $;
-@@ -1187,6 +1175,8 @@ package Snames is
- -- convention name. So is To_Address, which is a GNAT attribute.
-
- First_Intrinsic_Name : constant Name_Id := N + $;
-+ Name_Compilation_Date : constant Name_Id := N + $;
-+ Name_Compilation_Time : constant Name_Id := N + $;
- Name_Divide : constant Name_Id := N + $;
- Name_Enclosing_Entity : constant Name_Id := N + $;
- Name_Exception_Information : constant Name_Id := N + $;
-@@ -1298,6 +1288,7 @@ package Snames is
- Name_Include_Path_File : constant Name_Id := N + $;
- Name_Inherit_Source_Path : constant Name_Id := N + $;
- Name_Install : constant Name_Id := N + $;
-+ Name_Install_Name : constant Name_Id := N + $;
- Name_Languages : constant Name_Id := N + $;
- Name_Language_Kind : constant Name_Id := N + $;
- Name_Leading_Library_Options : constant Name_Id := N + $;
-@@ -1464,7 +1455,6 @@ package Snames is
- Attribute_Alignment,
- Attribute_Asm_Input,
- Attribute_Asm_Output,
-- Attribute_AST_Entry,
- Attribute_Atomic_Always_Lock_Free,
- Attribute_Bit,
- Attribute_Bit_Order,
-@@ -1480,6 +1470,7 @@ package Snames is
- Attribute_Constrained,
- Attribute_Count,
- Attribute_Default_Bit_Order,
-+ Attribute_Default_Scalar_Storage_Order,
- Attribute_Default_Iterator,
- Attribute_Definite,
- Attribute_Delta,
-@@ -1664,12 +1655,11 @@ package Snames is
- type Convention_Id is (
-
- -- The native-to-Ada (non-foreign) conventions come first. These include
-- -- the ones defined in the RM, plus Ghost and Stubbed.
-+ -- the ones defined in the RM, plus Stubbed.
-
- Convention_Ada,
- Convention_Intrinsic,
- Convention_Entry,
-- Convention_Ghost,
- Convention_Protected,
- Convention_Stubbed,
-
-@@ -1746,7 +1736,6 @@ package Snames is
- Pragma_Convention_Identifier,
- Pragma_Debug_Policy,
- Pragma_Detect_Blocking,
-- Pragma_Default_Scalar_Storage_Order,
- Pragma_Default_Storage_Pool,
- Pragma_Disable_Atomic_Synchronization,
- Pragma_Discard_Names,
-@@ -1757,16 +1746,15 @@ package Snames is
- Pragma_Extensions_Allowed,
- Pragma_External_Name_Casing,
- Pragma_Favor_Top_Level,
-- Pragma_Float_Representation,
- Pragma_Implicit_Packing,
- Pragma_Initialize_Scalars,
- Pragma_Interrupt_State,
- Pragma_License,
- Pragma_Locking_Policy,
-- Pragma_Long_Float,
- Pragma_Loop_Optimize,
- Pragma_No_Run_Time,
- Pragma_No_Strict_Aliasing,
-+ Pragma_No_Tagged_Streams,
- Pragma_Normalize_Scalars,
- Pragma_Optimize_Alignment,
- Pragma_Overflow_Mode,
-@@ -1774,6 +1762,7 @@ package Snames is
- Pragma_Partition_Elaboration_Policy,
- Pragma_Persistent_BSS,
- Pragma_Polling,
-+ Pragma_Prefix_Exception_Messages,
- Pragma_Priority_Specific_Dispatching,
- Pragma_Profile,
- Pragma_Profile_Warnings,
-@@ -1830,6 +1819,7 @@ package Snames is
- Pragma_CPP_Virtual,
- Pragma_CPP_Vtable,
- Pragma_Debug,
-+ Pragma_Default_Initial_Condition,
- Pragma_Depends,
- Pragma_Effective_Reads,
- Pragma_Effective_Writes,
-@@ -1837,20 +1827,20 @@ package Snames is
- Pragma_Elaborate_All,
- Pragma_Elaborate_Body,
- Pragma_Export,
-- Pragma_Export_Exception,
- Pragma_Export_Function,
- Pragma_Export_Object,
- Pragma_Export_Procedure,
- Pragma_Export_Value,
- Pragma_Export_Valued_Procedure,
-+ Pragma_Extensions_Visible,
- Pragma_External,
- Pragma_Finalize_Storage_Only,
-+ Pragma_Ghost,
- Pragma_Global,
- Pragma_Ident,
- Pragma_Implementation_Defined,
- Pragma_Implemented,
- Pragma_Import,
-- Pragma_Import_Exception,
- Pragma_Import_Function,
- Pragma_Import_Object,
- Pragma_Import_Procedure,
-@@ -1883,6 +1873,7 @@ package Snames is
- Pragma_Main_Storage,
- Pragma_Memory_Size,
- Pragma_No_Body,
-+ Pragma_No_Elaboration_Code_All,
- Pragma_No_Inline,
- Pragma_No_Return,
- Pragma_Obsolescent,
-@@ -1949,8 +1940,8 @@ package Snames is
- -- special processing required to deal with the fact that their names
- -- match existing attribute names.
-
-- Pragma_AST_Entry,
- Pragma_CPU,
-+ Pragma_Default_Scalar_Storage_Order,
- Pragma_Dispatching_Domain,
- Pragma_Fast_Math,
- Pragma_Interface,
-@@ -2042,12 +2033,12 @@ package Snames is
- -- Test to see if the name N is the name of an operator symbol
-
- function Is_Pragma_Name (N : Name_Id) return Boolean;
-- -- Test to see if the name N is the name of a recognized pragma. Note that
-- -- pragmas AST_Entry, CPU, Dispatching_Domain, Fast_Math,
-- -- Interrupt_Priority, Lock_Free, Priority, Storage_Size, and Storage_Unit
-- -- are recognized as pragmas by this function even though their names are
-- -- separate from the other pragma names. For this reason, clients should
-- -- always use this function, rather than do range tests on Name_Id values.
-+ -- Test to see if the name N is the name of a recognized pragma. Note
-+ -- that pragmas CPU, Dispatching_Domain, Fast_Math, Interrupt_Priority,
-+ -- Lock_Free, Priority, Storage_Size, and Storage_Unit are recognized
-+ -- as pragmas by this function even though their names are separate from
-+ -- the other pragma names. For this reason, clients should always use
-+ -- this function, rather than do range tests on Name_Id values.
-
- function Is_Configuration_Pragma_Name (N : Name_Id) return Boolean;
- -- Test to see if the name N is the name of a recognized configuration
-@@ -2087,10 +2078,8 @@ package Snames is
- -- Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
- -- if N is not a name of a known (Ada defined or GNAT-specific) pragma.
- -- Note that the function also works correctly for names of pragmas that
-- -- are not included in the main list of pragma Names (AST_Entry, CPU,
-- -- Dispatching_Domain, Interrupt_Priority, Lock_Free, Priority,
-- -- Storage_Size, and Storage_Unit (e.g. Name_Storage_Size returns
-- -- Pragma_Storage_Size).
-+ -- are not included in the main list of pragma Names (e.g. Name_CPU returns
-+ -- Pragma_CPU).
-
- function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
- -- Returns Id of queuing policy corresponding to given name. It is an error
-diff --git a/gnat/stand.adb b/gnat/stand.adb
-index c6ed55d..429f545 100644
---- a/gnat/stand.adb
-+++ b/gnat/stand.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/stand.ads b/gnat/stand.ads
-index d3f43e9..e93e9b4 100644
---- a/gnat/stand.ads
-+++ b/gnat/stand.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -443,8 +443,7 @@ package Stand is
- -- Entity for universal real type. The bounds of this type correspond to
- -- to the largest supported real type (i.e. Long_Long_Float). It is the
- -- type used for runtime calculations in type universal real. Note that
-- -- this type is always IEEE format, even if Long_Long_Float is Vax_Float
-- -- (and in that case the bounds don't correspond exactly).
-+ -- this type is always IEEE format.
-
- Universal_Fixed : Entity_Id;
- -- Entity for universal fixed type. This is a type with arbitrary
-diff --git a/gnat/stringt.adb b/gnat/stringt.adb
-index ea8d0ba..5a0c89c 100644
---- a/gnat/stringt.adb
-+++ b/gnat/stringt.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/stringt.ads b/gnat/stringt.ads
-index 77bcc07..92b74e2 100644
---- a/gnat/stringt.ads
-+++ b/gnat/stringt.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/styleg.adb b/gnat/styleg.adb
-index c94759c..a421f25 100644
---- a/gnat/styleg.adb
-+++ b/gnat/styleg.adb
-@@ -126,13 +126,32 @@ package body Styleg is
- -- Check_Arrow --
- -----------------
-
-- -- In check tokens mode (-gnatys), arrow must be surrounded by spaces
-+ -- In check tokens mode (-gnatys), arrow must be surrounded by spaces,
-+ -- except that within the argument of a Depends macro the required format
-+ -- is =>+ rather than => +).
-
-- procedure Check_Arrow is
-+ procedure Check_Arrow (Inside_Depends : Boolean := False) is
- begin
- if Style_Check_Tokens then
- Require_Preceding_Space;
-- Require_Following_Space;
-+
-+ if not Inside_Depends then
-+ Require_Following_Space;
-+
-+ -- Special handling for Inside_Depends
-+
-+ else
-+ if Source (Scan_Ptr) = ' '
-+ and then Source (Scan_Ptr + 1) = '+'
-+ then
-+ Error_Space_Not_Allowed (Scan_Ptr);
-+
-+ elsif Source (Scan_Ptr) /= ' '
-+ and then Source (Scan_Ptr) /= '+'
-+ then
-+ Require_Following_Space;
-+ end if;
-+ end if;
- end if;
- end Check_Arrow;
-
-@@ -1032,10 +1051,17 @@ package body Styleg is
- -- In check token mode (-gnatyt), unary plus or minus must not be
- -- followed by a space.
-
-- procedure Check_Unary_Plus_Or_Minus is
-+ -- Annoying exception: if we have the sequence =>+ within a Depends pragma
-+ -- or aspect, then we insist on a space rather than forbidding it.
-+
-+ procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False) is
- begin
- if Style_Check_Tokens then
-- Check_No_Space_After;
-+ if not Inside_Depends then
-+ Check_No_Space_After;
-+ else
-+ Require_Following_Space;
-+ end if;
- end if;
- end Check_Unary_Plus_Or_Minus;
-
-diff --git a/gnat/styleg.ads b/gnat/styleg.ads
-index 2369281..344d4fb 100644
---- a/gnat/styleg.ads
-+++ b/gnat/styleg.ads
-@@ -2,11 +2,11 @@
- -- --
- -- GNAT COMPILER COMPONENTS --
- -- --
---- S T Y L E G --
-+-- S T Y L E G --
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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,8 +52,10 @@ package Styleg is
- procedure Check_Apostrophe;
- -- Called after scanning an apostrophe to check spacing
-
-- procedure Check_Arrow;
-- -- Called after scanning out an arrow to check spacing
-+ procedure Check_Arrow (Inside_Depends : Boolean := False);
-+ -- Called after scanning out an arrow to check spacing. Inside_Depends is
-+ -- true if the call is from an argument of the Depends pragma (where the
-+ -- allowed/required format is =>+).
-
- procedure Check_Attribute_Name (Reserved : Boolean);
- -- The current token is an attribute designator. Check that it
-@@ -143,8 +145,10 @@ package Styleg is
- -- would interfere with coverage testing). Handles case of THEN ABORT as
- -- an exception, as well as PRAGMA after ELSE.
-
-- procedure Check_Unary_Plus_Or_Minus;
-- -- Called after scanning a unary plus or minus to check spacing
-+ procedure Check_Unary_Plus_Or_Minus (Inside_Depends : Boolean := False);
-+ -- Called after scanning a unary plus or minus to check spacing. The flag
-+ -- Inside_Depends is set if we are scanning within a Depends pragma or
-+ -- Aspect, in which case =>+ requires a following space).
-
- procedure Check_Vertical_Bar;
- -- Called after scanning a vertical bar to check spacing
-diff --git a/gnat/table.adb b/gnat/table.adb
-index 219cfc5..4c74539 100644
---- a/gnat/table.adb
-+++ b/gnat/table.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -399,7 +399,11 @@ package body Table is
- Tree_Read_Data
- (Tree_Get_Table_Address,
- (Last_Val - Int (First) + 1) *
-- Table_Type'Component_Size / Storage_Unit);
-+
-+ -- Note the importance of parenthesizing the following division
-+ -- to avoid the possibility of intermediate overflow.
-+
-+ (Table_Type'Component_Size / Storage_Unit));
- end Tree_Read;
-
- ----------------
-@@ -415,7 +419,7 @@ package body Table is
- Tree_Write_Data
- (Tree_Get_Table_Address,
- (Last_Val - Int (First) + 1) *
-- Table_Type'Component_Size / Storage_Unit);
-+ (Table_Type'Component_Size / Storage_Unit));
- end Tree_Write;
-
- begin
-diff --git a/gnat/table.ads b/gnat/table.ads
-index 24103a3..2b398d7 100644
---- a/gnat/table.ads
-+++ b/gnat/table.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/targparm.adb b/gnat/targparm.adb
-index 0f93344..8824f4f 100644
---- a/gnat/targparm.adb
-+++ b/gnat/targparm.adb
-@@ -55,7 +55,6 @@ package body Targparm is
- MOV, -- Machine_Overflows
- MRN, -- Machine_Rounds
- PAS, -- Preallocated_Stacks
-- RTX, -- RTX_RTSS_Kernel_Module
- SAG, -- Support_Aggregates
- SAP, -- Support_Atomic_Primitives
- SCA, -- Support_Composite_Assign
-@@ -67,8 +66,6 @@ package body Targparm is
- SNZ, -- Signed_Zeros
- SSL, -- Suppress_Standard_Library
- UAM, -- Use_Ada_Main_Program_Name
-- VMS, -- OpenVMS
-- VXF, -- VAX Float
- ZCD); -- ZCX_By_Default
-
- Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
-@@ -93,7 +90,6 @@ package body Targparm is
- MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
- MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
- PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
-- RTX_Str : aliased constant Source_Buffer := "RTX_RTSS_Kernel_Module";
- SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
- SAP_Str : aliased constant Source_Buffer := "Support_Atomic_Primitives";
- SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
-@@ -105,8 +101,6 @@ package body Targparm is
- SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
- SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
- UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
-- VMS_Str : aliased constant Source_Buffer := "OpenVMS";
-- VXF_Str : aliased constant Source_Buffer := "VAX_Float";
- ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
-
- -- The following defines a set of pointers to the above strings,
-@@ -131,7 +125,6 @@ package body Targparm is
- MOV_Str'Access,
- MRN_Str'Access,
- PAS_Str'Access,
-- RTX_Str'Access,
- SAG_Str'Access,
- SAP_Str'Access,
- SCA_Str'Access,
-@@ -143,8 +136,6 @@ package body Targparm is
- SNZ_Str'Access,
- SSL_Str'Access,
- UAM_Str'Access,
-- VMS_Str'Access,
-- VXF_Str'Access,
- ZCD_Str'Access);
-
- -----------------------
-@@ -221,6 +212,16 @@ package body Targparm is
-
- Opt.Address_Is_Private := False;
-
-+ -- Loop through source lines
-+
-+ -- Note: in the case or pragmas, we are only interested in pragmas that
-+ -- appear as configuration pragmas. These are left justified, so they
-+ -- do not have three spaces at the start. Pragmas appearing within the
-+ -- package (like Pure and No_Elaboration_Code_All) will have the three
-+ -- spaces at the start and so will be ignored.
-+
-+ -- For a special exception, see processing for pragma Pure below
-+
- P := Source_First;
- Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop
-
-@@ -470,12 +471,6 @@ package body Targparm is
- Opt.Polling_Required := True;
- goto Line_Loop_Continue;
-
-- -- Ignore pragma Pure (System)
--
-- elsif System_Text (P .. P + 20) = "pragma Pure (System);" then
-- P := P + 21;
-- goto Line_Loop_Continue;
--
- -- Queuing Policy
-
- elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then
-@@ -503,9 +498,20 @@ package body Targparm is
- Opt.Task_Dispatching_Policy_Sloc := System_Location;
- goto Line_Loop_Continue;
-
-- -- No other pragmas are permitted
-+ -- No other configuration pragmas are permitted
-
- elsif System_Text (P .. P + 6) = "pragma " then
-+
-+ -- Special exception, we allow pragma Pure (System) appearing in
-+ -- column one. This is an obsolete usage which may show up in old
-+ -- tests with an obsolete version of system.ads, so we recognize
-+ -- and ignore it to make life easier in handling such tests.
-+
-+ if System_Text (P .. P + 20) = "pragma Pure (System);" then
-+ P := P + 21;
-+ goto Line_Loop_Continue;
-+ end if;
-+
- Set_Standard_Error;
- Write_Line ("unrecognized line in system.ads: ");
-
-@@ -666,7 +672,6 @@ package body Targparm is
- when MOV => Machine_Overflows_On_Target := Result;
- when MRN => Machine_Rounds_On_Target := Result;
- when PAS => Preallocated_Stacks_On_Target := Result;
-- when RTX => RTX_RTSS_Kernel_Module_On_Target := Result;
- when SAG => Support_Aggregates_On_Target := Result;
- when SAP => Support_Atomic_Primitives_On_Target := Result;
- when SCA => Support_Composite_Assign_On_Target := Result;
-@@ -678,8 +683,6 @@ package body Targparm is
- when SSL => Suppress_Standard_Library_On_Target := Result;
- when SNZ => Signed_Zeros_On_Target := Result;
- when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
-- when VMS => OpenVMS_On_Target := Result;
-- when VXF => VAX_Float_On_Target := Result;
- when ZCD => ZCX_By_Default_On_Target := Result;
-
- goto Line_Loop_Continue;
-@@ -716,13 +719,6 @@ package body Targparm is
- end if;
- end loop Line_Loop;
-
-- -- Now that OpenVMS_On_Target has been given its definitive value,
-- -- change the multi-unit index character from '~' to '$' for OpenVMS.
--
-- if OpenVMS_On_Target then
-- Multi_Unit_Index_Character := '$';
-- end if;
--
- if Fatal then
- raise Unrecoverable_Error;
- end if;
-diff --git a/gnat/targparm.ads b/gnat/targparm.ads
-index 21f2d6d..efb6e02 100644
---- a/gnat/targparm.ads
-+++ b/gnat/targparm.ads
-@@ -179,13 +179,13 @@ package Targparm is
-
- -- The default values here are used if no value is found in system.ads.
- -- This should normally happen if the special version of system.ads used
-- -- by the compiler itself is in use or if the value is only relevant to
-- -- a particular target (e.g. OpenVMS, AAMP). The default values are
-- -- suitable for use in normal environments. This approach allows the
-- -- possibility of new versions of the compiler (possibly with new system
-- -- parameters added) being used to compile older versions of the compiler
-- -- sources, as well as avoiding duplicating values in all system-*.ads
-- -- files for flags that are used on a few platforms only.
-+ -- by the compiler itself is in use or if the value is only relevant to a
-+ -- particular target (e.g. AAMP). The default values are suitable for use
-+ -- in normal environments. This approach allows the possibility of new
-+ -- versions of the compiler (possibly with new system parameters added)
-+ -- being used to compile older versions of the compiler sources, as well as
-+ -- avoiding duplicating values in all system-*.ads files for flags that are
-+ -- used on a few platforms only.
-
- -- All these parameters should be regarded as read only by all clients
- -- of the package. The only way they get modified is by calling the
-@@ -203,15 +203,6 @@ package Targparm is
- AAMP_On_Target : Boolean := False;
- -- Set to True if target is AAMP
-
-- OpenVMS_On_Target : Boolean := False;
-- -- Set to True if target is OpenVMS
--
-- VAX_Float_On_Target : Boolean := False;
-- -- Set to True if target float format is VAX Float
--
-- RTX_RTSS_Kernel_Module_On_Target : Boolean := False;
-- -- Set to True if target is RTSS module for RTX
--
- type Virtual_Machine_Kind is (No_VM, JVM_Target, CLI_Target);
- VM_Target : Virtual_Machine_Kind := No_VM;
- -- Kind of virtual machine targetted
-@@ -358,8 +349,6 @@ package Targparm is
- -- The calls to __gnat_initialize and __gnat_finalize are omitted
- --
- -- All finalization and initialization (controlled types) is omitted
-- --
-- -- The routine __gnat_handler_installed is not imported
-
- Preallocated_Stacks_On_Target : Boolean := False;
- -- If this flag is True, then the expander preallocates all task stacks
-diff --git a/gnat/tempdir.adb b/gnat/tempdir.adb
-index 7da1ef2..4936c26 100644
---- a/gnat/tempdir.adb
-+++ b/gnat/tempdir.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 2003-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 2003-2014, 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- --
-@@ -25,7 +25,6 @@
-
- with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-
--with Hostparm; use Hostparm;
- with Opt; use Opt;
- with Output; use Output;
-
-@@ -33,9 +32,8 @@ package body Tempdir is
-
- Tmpdir_Needs_To_Be_Displayed : Boolean := True;
-
-- Tmpdir : constant String := "TMPDIR";
-- Gnutmpdir : constant String := "GNUTMPDIR";
-- Temp_Dir : String_Access := new String'("");
-+ Tmpdir : constant String := "TMPDIR";
-+ Temp_Dir : String_Access := new String'("");
-
- ----------------------
- -- Create_Temp_File --
-@@ -118,21 +116,7 @@ package body Tempdir is
-
- begin
- if Status then
--
-- -- On VMS, if GNUTMPDIR is defined, use it
--
-- if OpenVMS then
-- Dir := Getenv (Gnutmpdir);
--
-- -- Otherwise, if GNUTMPDIR is not defined, try TMPDIR
--
-- if Dir'Length = 0 then
-- Dir := Getenv (Tmpdir);
-- end if;
--
-- else
-- Dir := Getenv (Tmpdir);
-- end if;
-+ Dir := Getenv (Tmpdir);
- end if;
-
- Free (Temp_Dir);
-diff --git a/gnat/tree_io.adb b/gnat/tree_io.adb
-index 9969736..addefd0 100644
---- a/gnat/tree_io.adb
-+++ b/gnat/tree_io.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/tree_io.ads b/gnat/tree_io.ads
-index 6de41e2..75816be 100644
---- a/gnat/tree_io.ads
-+++ b/gnat/tree_io.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/types.adb b/gnat/types.adb
-index 3c74ffc..67d15cf 100644
---- a/gnat/types.adb
-+++ b/gnat/types.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/types.ads b/gnat/types.ads
-index 8dc6333..ed3eac1 100644
---- a/gnat/types.ads
-+++ b/gnat/types.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2015, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -107,7 +107,7 @@ package Types is
-
- subtype Upper_Half_Character is
- Character range Character'Val (16#80#) .. Character'Val (16#FF#);
-- -- Characters with the upper bit set
-+ -- 8-bit Characters with the upper bit set
-
- type Character_Ptr is access all Character;
- type String_Ptr is access all String;
-@@ -659,7 +659,7 @@ package Types is
- type Check_Id is new Nat;
- -- Type used to represent a check id
-
-- No_Check_Id : constant := 0;
-+ No_Check_Id : constant := 0;
- -- Check_Id value used to indicate no check
-
- Access_Check : constant := 1;
-@@ -795,11 +795,11 @@ package Types is
- -- mechanism. See specification of Sem_Mech for full details. The following
- -- subtype is used to represent values of this type:
-
-- subtype Mechanism_Type is Int range -18 .. Int'Last;
-+ subtype Mechanism_Type is Int range -2 .. Int'Last;
- -- Type used to represent a mechanism value. This is a subtype rather than
- -- a type to avoid some annoying processing problems with certain routines
- -- in Einfo (processing them to create the corresponding C). The values in
-- -- the range -18 .. 0 are used to represent mechanism types declared as
-+ -- the range -2 .. 0 are used to represent mechanism types declared as
- -- named constants in the spec of Sem_Mech. Positive values are used for
- -- the case of a pragma C_Pass_By_Copy that sets a threshold value for the
- -- mechanism to be used. For example if pragma C_Pass_By_Copy (32) is given
-diff --git a/gnat/uintp.adb b/gnat/uintp.adb
-index 150e484..7a55439 100644
---- a/gnat/uintp.adb
-+++ b/gnat/uintp.adb
-@@ -6,7 +6,7 @@
- -- --
- -- B o d y --
- -- --
---- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -171,22 +171,6 @@ package body Uintp is
- -- If Discard_Quotient is True, Quotient is set to No_Uint
- -- If Discard_Remainder is True, Remainder is set to No_Uint
-
-- function Vector_To_Uint
-- (In_Vec : UI_Vector;
-- Negative : Boolean) return Uint;
-- -- Functions that calculate values in UI_Vectors, call this function to
-- -- create and return the Uint value. In_Vec contains the multiple precision
-- -- (Base) representation of a non-negative value. Leading zeroes are
-- -- permitted. Negative is set if the desired result is the negative of the
-- -- given value. The result will be either the appropriate directly
-- -- represented value, or a table entry in the proper canonical format is
-- -- created and returned.
-- --
-- -- Note that Init_Operand puts a signed value in the result vector, but
-- -- Vector_To_Uint is always presented with a non-negative value. The
-- -- processing of signs is something that is done by the caller before
-- -- calling Vector_To_Uint.
--
- ------------
- -- Direct --
- ------------
-@@ -1678,6 +1662,15 @@ package body Uintp is
- Image_Out (Input, True, Format);
- end UI_Image;
-
-+ function UI_Image
-+ (Input : Uint;
-+ Format : UI_Format := Auto) return String
-+ is
-+ begin
-+ Image_Out (Input, True, Format);
-+ return UI_Image_Buffer (1 .. UI_Image_Length);
-+ end UI_Image;
-+
- -------------------------
- -- UI_Is_In_Int_Range --
- -------------------------
-diff --git a/gnat/uintp.ads b/gnat/uintp.ads
-index 7f9ce66..1d90524 100644
---- a/gnat/uintp.ads
-+++ b/gnat/uintp.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-@@ -90,6 +90,18 @@ package Uintp is
- Uint_Minus_80 : constant Uint;
- Uint_Minus_128 : constant Uint;
-
-+ type UI_Vector is array (Pos range <>) of Int;
-+ -- Vector containing the integer values of a Uint value
-+
-+ -- Note: An earlier version of this package used pointers of arrays of Ints
-+ -- (dynamically allocated) for the Uint type. The change leads to a few
-+ -- less natural idioms used throughout this code, but eliminates all uses
-+ -- of the heap except for the table package itself. For example, Uint
-+ -- parameters are often converted to UI_Vectors for internal manipulation.
-+ -- This is done by creating the local UI_Vector using the function N_Digits
-+ -- on the Uint to find the size needed for the vector, and then calling
-+ -- Init_Operand to copy the values out of the table into the vector.
-+
- -----------------
- -- Subprograms --
- -----------------
-@@ -252,6 +264,22 @@ package Uintp is
- -- function is used for capacity checks, and it can be one bit off
- -- without affecting its usage.
-
-+ function Vector_To_Uint
-+ (In_Vec : UI_Vector;
-+ Negative : Boolean) return Uint;
-+ -- Functions that calculate values in UI_Vectors, call this function to
-+ -- create and return the Uint value. In_Vec contains the multiple precision
-+ -- (Base) representation of a non-negative value. Leading zeroes are
-+ -- permitted. Negative is set if the desired result is the negative of the
-+ -- given value. The result will be either the appropriate directly
-+ -- represented value, or a table entry in the proper canonical format is
-+ -- created and returned.
-+ --
-+ -- Note that Init_Operand puts a signed value in the result vector, but
-+ -- Vector_To_Uint is always presented with a non-negative value. The
-+ -- processing of signs is something that is done by the caller before
-+ -- calling Vector_To_Uint.
-+
- ---------------------
- -- Output Routines --
- ---------------------
-@@ -271,10 +299,15 @@ package Uintp is
- -- followed by the value in UI_Image_Buffer. The form of the value is an
- -- integer literal in either decimal (no base) or hexadecimal (base 16)
- -- format. If Hex is True on entry, then hex mode is forced, otherwise
-- -- UI_Image makes a guess at which output format is more convenient.
-- -- The value must fit in UI_Image_Buffer. If necessary, the result is an
-- -- approximation of the proper value, using an exponential format. The
-- -- image of No_Uint is output as a single question mark.
-+ -- UI_Image makes a guess at which output format is more convenient. The
-+ -- value must fit in UI_Image_Buffer. The actual length of the result is
-+ -- returned in UI_Image_Length. If necessary to meet this requirement, the
-+ -- result is an approximation of the proper value, using an exponential
-+ -- format. The image of No_Uint is output as a single question mark.
-+
-+ function UI_Image (Input : Uint; Format : UI_Format := Auto) return String;
-+ -- Functional form, in which the result is returned as a string. This call
-+ -- also leaves the result in UI_Image_Buffer/Length as described above.
-
- procedure UI_Write (Input : Uint; Format : UI_Format := Auto);
- -- Writes a representation of Uint, consisting of a possible minus sign,
-@@ -494,18 +527,6 @@ private
- -- UI_Vector is defined for this purpose and some internal subprograms
- -- used for converting from one to the other are defined.
-
-- type UI_Vector is array (Pos range <>) of Int;
-- -- Vector containing the integer values of a Uint value
--
-- -- Note: An earlier version of this package used pointers of arrays of Ints
-- -- (dynamically allocated) for the Uint type. The change leads to a few
-- -- less natural idioms used throughout this code, but eliminates all uses
-- -- of the heap except for the table package itself. For example, Uint
-- -- parameters are often converted to UI_Vectors for internal manipulation.
-- -- This is done by creating the local UI_Vector using the function N_Digits
-- -- on the Uint to find the size needed for the vector, and then calling
-- -- Init_Operand to copy the values out of the table into the vector.
--
- type Uint_Entry is record
- Length : Pos;
- -- Length of entry in Udigits table in digits (i.e. in words)
-diff --git a/gnat/uname.adb b/gnat/uname.adb
-index 2ae5dc1..e0a1e72 100644
---- a/gnat/uname.adb
-+++ b/gnat/uname.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/uname.ads b/gnat/uname.ads
-index 357cc65..9b38d9a 100644
---- a/gnat/uname.ads
-+++ b/gnat/uname.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/urealp.adb b/gnat/urealp.adb
-index 5e9eece..f2f036b 100644
---- a/gnat/urealp.adb
-+++ b/gnat/urealp.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/urealp.ads b/gnat/urealp.ads
-index 8910935..d9d63ea 100644
---- a/gnat/urealp.ads
-+++ b/gnat/urealp.ads
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/widechar.adb b/gnat/widechar.adb
-index 000d7f3..d0c8f24 100644
---- a/gnat/widechar.adb
-+++ b/gnat/widechar.adb
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/gnat/widechar.ads b/gnat/widechar.ads
-index aa1e3d2..a6e8293 100644
---- a/gnat/widechar.ads
-+++ b/gnat/widechar.ads
-@@ -6,7 +6,7 @@
- -- --
- -- S p e c --
- -- --
---- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
-+-- Copyright (C) 1992-2014, 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- --
-@@ -15,9 +15,9 @@
- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE. --
- -- --
---- --
---- --
---- --
-+-- As a special exception under Section 7 of GPL version 3, you are granted --
-+-- additional permissions described in the GCC Runtime Library Exception, --
-+-- version 3.1, as published by the Free Software Foundation. --
- -- --
- -- You should have received a copy of the GNU General Public License and --
- -- a copy of the GCC Runtime Library Exception along with this program; --
-diff --git a/src/gprbuild-main.adb b/src/gprbuild-main.adb
-index 860ae23..00edad3 100644
---- a/src/gprbuild-main.adb
-+++ b/src/gprbuild-main.adb
-@@ -682,22 +682,12 @@ procedure Gprbuild.Main is
- end if;
-
- elsif Arg = "--db-" then
-- if Hostparm.OpenVMS then
-- Fail_Program
-- (Project_Tree,
-- "--db- cannot be used on VMS");
-- end if;
-
- Forbidden_In_Package_Builder;
-
- Load_Standard_Base := False;
-
- elsif Arg = "--db" then
-- if Hostparm.OpenVMS then
-- Fail_Program
-- (Project_Tree,
-- "--db cannot be used on VMS");
-- end if;
-
- Forbidden_In_Package_Builder;
-
-@@ -747,11 +737,6 @@ procedure Gprbuild.Main is
- Arg (1 .. Autoconf_Project_Option'Length) =
- Autoconf_Project_Option
- then
-- if Hostparm.OpenVMS then
-- Fail_Program
-- (Project_Tree,
-- Autoconf_Project_Option & " cannot be used on VMS");
-- end if;
-
- Forbidden_In_Package_Builder;
-
-@@ -776,11 +761,6 @@ procedure Gprbuild.Main is
- and then
- Arg (1 .. Target_Project_Option'Length) = Target_Project_Option
- then
-- if Hostparm.OpenVMS then
-- Fail_Program
-- (Project_Tree,
-- Target_Project_Option & " cannot be used on VMS");
-- end if;
-
- Forbidden_In_Package_Builder;
-
-@@ -1631,45 +1611,6 @@ procedure Gprbuild.Main is
- Write_Str (" Specify the main config project file name");
- Write_Eol;
-
-- -- Line for Autoconf_Project_Option
--
-- if not Hostparm.OpenVMS then
-- Write_Str (" ");
-- Write_Str (Autoconf_Project_Option);
-- Write_Str ("file.cgpr");
-- Write_Eol;
-- Write_Str
-- (" Specify/create the main config project file name");
-- Write_Eol;
-- end if;
--
-- -- Line for Target_Project_Option
--
-- if not Hostparm.OpenVMS then
-- Write_Str (" ");
-- Write_Str (Target_Project_Option);
-- Write_Str ("targetname");
-- Write_Eol;
-- Write_Str
-- (" Specify a target for cross platforms");
-- Write_Eol;
-- end if;
--
-- -- Line for --db
--
-- if not Hostparm.OpenVMS then
-- Write_Str (" --db dir Parse dir as an additional knowledge base");
-- Write_Eol;
-- end if;
--
-- -- Line for --db-
--
-- if not Hostparm.OpenVMS then
-- Write_Str (" --db- Do not load the standard knowledge base");
-- Write_Eol;
-- end if;
--
-- -- Line for --subdirs=
-
- Write_Str (" --subdirs=dir");
- Write_Eol;
-diff --git a/src/gprconfig-main.adb b/src/gprconfig-main.adb
-index 476690a..70e3e80 100644
---- a/src/gprconfig-main.adb
-+++ b/src/gprconfig-main.adb
-@@ -476,7 +476,7 @@ begin
- Get_Targets_Set
- (Base, To_String (Selected_Target), Selected_Targets_Set);
-
-- if Batch or Hostparm.OpenVMS then
-+ if Batch then
- Complete_Command_Line_Compilers
- (Base,
- Selected_Targets_Set,
-diff --git a/src/gpr_version.adb b/src/gpr_version.adb
-index 4ec66a8..64c82cc 100644
---- a/src/gpr_version.adb
-+++ b/src/gpr_version.adb
-@@ -66,8 +66,6 @@ package body GPR_Version is
- end loop Last_Loop;
-
- case Build_Type is
-- when Gnatpro =>
-- return "Pro " & Gpr_Version & " " & Date & Host;
- when GPL =>
- return "GPL " & Gpr_Version & " " & Date & Host;
- when FSF =>
-diff --git a/gnat/gnatvsn.adb b/gnat/gnatvsn.adb
-index 6d76f7e..c794b8c 100644
---- a/gnat/gnatvsn.adb
-+++ b/gnat/gnatvsn.adb
-@@ -66,19 +66,16 @@ package body Gnatvsn is
- -------------------------
-
- function Gnat_Version_String return String is
-- S : String (1 .. Ver_Len_Max);
-- Pos : Natural := 0;
- begin
-- loop
-- exit when Version_String (Pos) = ASCII.NUL;
--
-- S (Pos + 1) := Version_String (Pos);
-- Pos := Pos + 1;
--
-- exit when Pos = Ver_Len_Max;
-- end loop;
--
-- return S (1 .. Pos);
-+ case Build_Type is
-+ when Gnatpro =>
-+ return "Pro " & Gnat_Static_Version_String;
-+ when GPL =>
-+ return "GPL " & Gnat_Static_Version_String;
-+ when FSF =>
-+ return Gnat_Static_Version_String;
-+ end case;
- end Gnat_Version_String;
-
-+
- end Gnatvsn;
-diff --git a/gnat/gnatvsn.adb b/gnat/gnatvsn.adb
-index c794b8c..aedfffa 100644
---- a/gnat/gnatvsn.adb
-+++ b/gnat/gnatvsn.adb
-@@ -68,8 +68,6 @@ package body Gnatvsn is
- function Gnat_Version_String return String is
- begin
- case Build_Type is
-- when Gnatpro =>
-- return "Pro " & Gnat_Static_Version_String;
- when GPL =>
- return "GPL " & Gnat_Static_Version_String;
- when FSF =>
-diff --git a/src/gprbuild-main.adb b/src/gprbuild-main.adb
-index 00edad3..0dd1a8e 100644
---- a/src/gprbuild-main.adb
-+++ b/src/gprbuild-main.adb
-@@ -185,6 +185,7 @@ procedure Gprbuild.Main is
- Queue.Insert
- (Source => (Format => Format_Gprbuild,
- Tree => Main_Id.Tree,
-+ Closure => False,
- Id => Main_Id.Source),
- With_Roots => Builder_Data (Main_Id.Tree).Closure_Needed);
-
-diff --git a/src/gprbuild-post_compile.adb b/src/gprbuild-post_compile.adb
-index 2755482..b8f5548 100644
---- a/src/gprbuild-post_compile.adb
-+++ b/src/gprbuild-post_compile.adb
-@@ -2559,6 +2559,7 @@ package body Gprbuild.Post_Compile is
- Queue.Insert
- (Source => (Format => Format_Gprbuild,
- Tree => Main_File.Tree,
-+ Closure => False,
- Id => Main_File.Source));
- end if;
-
-@@ -2568,6 +2569,7 @@ package body Gprbuild.Post_Compile is
- Queue.Insert
- (Source => (Format => Format_Gprbuild,
- Tree => Main_File.Tree,
-+ Closure => False,
- Id => Roots.Root));
- Roots := Roots.Next;
- end loop;
-@@ -2628,6 +2630,7 @@ package body Gprbuild.Post_Compile is
- Queue.Insert
- (Source => (Format => Format_Gprbuild,
- Tree => Main_File.Tree,
-+ Closure => False,
- Id => Source));
- end if;
-
-diff --git a/src/gprbind.adb b/src/gprbind.adb
-index 7bfefd2..32ccdce 100644
---- a/src/gprbind.adb
-+++ b/src/gprbind.adb
-@@ -250,9 +250,6 @@ begin
-
- -- Copy_Attributes always fails on VMS
-
-- if Hostparm.OpenVMS then
-- Preserve := None;
-- end if;
-
- Exchange_File_Name := new String'(Argument (1));
-
-diff --git a/src/gprclean-main.adb b/src/gprclean-main.adb
-index 8cac791..6622e20 100644
---- a/src/gprclean-main.adb
-+++ b/src/gprclean-main.adb
-@@ -168,13 +168,7 @@ procedure Gprclean.Main is
-
- case Arg (2) is
- when '-' =>
-- if not Hostparm.OpenVMS and then Arg = "--db-" then
-- Load_Standard_Base := False;
--
-- elsif not Hostparm.OpenVMS and then Arg = "--db" then
-- Db_Directory_Expected := True;
--
-- elsif Arg'Length > Config_Project_Option'Length
-+ if Arg'Length > Config_Project_Option'Length
- and then Arg (1 .. Config_Project_Option'Length) =
- Config_Project_Option
- then
-@@ -222,59 +216,6 @@ procedure Gprclean.Main is
- (Slave_Env_Option'Length + 2 .. Arg'Last));
- end if;
-
-- elsif not Hostparm.OpenVMS
-- and then
-- Arg'Length > Autoconf_Project_Option'Length
-- and then
-- Arg (1 .. Autoconf_Project_Option'Length) =
-- Autoconf_Project_Option
-- then
-- if Config_Project_File_Name /= null
-- and then
-- (not Autoconf_Specified
-- or else
-- Config_Project_File_Name.all /=
-- Arg (Autoconf_Project_Option'Length + 1
-- .. Arg'Last))
-- then
-- Fail_Program
-- (Project_Tree,
-- "several configuration switches cannot "
-- & "be specified");
--
-- else
-- Config_Project_File_Name :=
-- new String'
-- (Arg (Autoconf_Project_Option'Length + 1
-- .. Arg'Last));
-- Autoconf_Specified := True;
-- end if;
--
-- elsif not Hostparm.OpenVMS
-- and then
-- Arg'Length > Target_Project_Option'Length
-- and then
-- Arg (1 .. Target_Project_Option'Length) =
-- Target_Project_Option
-- then
-- if Target_Name /= null then
-- if Target_Name.all /=
-- Arg (Target_Project_Option'Length + 1
-- .. Arg'Last)
-- then
-- Fail_Program
-- (Project_Tree,
-- "several target switches "
-- & "cannot be specified");
-- end if;
--
-- else
-- Target_Name :=
-- new String'
-- (Arg (Target_Project_Option'Length + 1
-- .. Arg'Last));
-- end if;
--
- elsif Arg'Length > RTS_Option'Length
- and then Arg (1 .. RTS_Option'Length) = RTS_Option
- then
-@@ -557,24 +498,15 @@ procedure Gprclean.Main is
- Put_Line (" --config=file.cgpr");
- Put_Line (" Specify the configuration project file name");
-
-- if not Hostparm.OpenVMS then
-- Put_Line (" --autoconf=file.cgpr");
-- Put_Line
-- (" Specify/create the main config project file name");
-- end if;
-+ Put_Line (" --autoconf=file.cgpr");
-+ Put_Line (" Specify/create the main config project file name");
-
-- if not Hostparm.OpenVMS then
-- Put_Line (" --target=targetname");
-- Put_Line (" Specify a target for cross platforms");
-- end if;
-+ Put_Line (" --target=targetname");
-+ Put_Line (" Specify a target for cross platforms");
-
-- if not Hostparm.OpenVMS then
-- Put_Line (" --db dir Parse dir as an additional knowledge base");
-- end if;
-+ Put_Line (" --db dir Parse dir as an additional knowledge base");
-
-- if not Hostparm.OpenVMS then
-- Put_Line (" --db- Do not load the standard knowledge base");
-- end if;
-+ Put_Line (" --db- Do not load the standard knowledge base");
-
- Put_Line (" --RTS=<runtime>");
- Put_Line (" Use runtime <runtime> for language Ada");
-diff --git a/src/gprinstall-main.adb b/src/gprinstall-main.adb
-index f736eb6..05141db 100644
---- a/src/gprinstall-main.adb
-+++ b/src/gprinstall-main.adb
-@@ -224,11 +224,6 @@ procedure Gprinstall.Main is
- end if;
-
- elsif Has_Prefix (Autoconf_Project_Option) then
-- if Hostparm.OpenVMS then
-- Fail_Program
-- (Project_Tree,
-- Autoconf_Project_Option & " cannot be used on VMS");
-- end if;
-
- if Config_Project_File_Name /= null
- and then (not Autoconf_Specified
-@@ -599,18 +594,6 @@ procedure Gprinstall.Main is
- Write_Str (" Specify the main config project file name");
- Write_Eol;
-
-- -- Line for Autoconf_Project_Option
--
-- if not Hostparm.OpenVMS then
-- Write_Str (" ");
-- Write_Str (Autoconf_Project_Option);
-- Write_Str ("file.cgpr");
-- Write_Eol;
-- Write_Str
-- (" Specify/create the main config project file name");
-- Write_Eol;
-- end if;
--
- -- Line for --prefix
-
- Write_Line (" --prefix=<dir>");
-diff --git a/src/gprlib.adb b/src/gprlib.adb
-index 3d81609..0e14350 100644
---- a/src/gprlib.adb
-+++ b/src/gprlib.adb
-@@ -63,8 +63,6 @@ procedure Gprlib is
- Gcc_Name : constant String := "gcc";
-
- Preserve : Attribute := Time_Stamps;
-- -- Used by Copy_ALI_Files. Changed to None for OpenVMS, because
-- -- Copy_Attributes always fails on VMS.
-
- Object_Suffix : constant String := Get_Target_Object_Suffix.all;
- -- The suffix of object files on this platform
-@@ -868,10 +866,6 @@ begin
-
- -- Copy_Attributes always fails on VMS
-
-- if Hostparm.OpenVMS then
-- Preserve := None;
-- Shared_Libgnat_Separator := '_';
-- end if;
-
- if Argument_Count /= 1 then
- Put_Line ("usage: gprlib <input file>");
-@@ -1173,13 +1167,6 @@ begin
- -- On VMS, replace all '.' with '_', to avoid names with
- -- several dots.
-
-- if Hostparm.OpenVMS then
-- for J in 6 .. Last loop
-- if Line (J) = '.' then
-- Line (J) := '_';
-- end if;
-- end loop;
-- end if;
-
- Libgnat :=
- new String'
diff --git a/gprbuild-2014-gcc5.patch b/gprbuild-2014-gcc5.patch
new file mode 100644
index 0000000..2ac08e6
--- /dev/null
+++ b/gprbuild-2014-gcc5.patch
@@ -0,0 +1,19 @@
+diff --git a/src/gprlib.adb b/src/gprlib.adb
+index 3d81609..4f574db 100644
+--- a/src/gprlib.adb
++++ b/src/gprlib.adb
+@@ -1185,12 +1185,12 @@ begin
+ new String'
+ ("-lgnat" &
+ Shared_Libgnat_Separator &
+- Line (6 .. Last));
++ "5");
+ Libgnarl :=
+ new String'
+ ("-lgnarl" &
+ Shared_Libgnat_Separator &
+- Line (6 .. Last));
++ "5");
+ end if;
+
+ else
diff --git a/gprbuild.spec b/gprbuild.spec
index fdcfb16..787a3e8 100644
--- a/gprbuild.spec
+++ b/gprbuild.spec
@@ -1,6 +1,6 @@
Name: gprbuild
Version: 2014
-Release: 3%{?dist}
+Release: 4%{?dist}
Summary: Ada project builder
Group: Development/Languages
License: GPLv2+
@@ -12,7 +12,8 @@ Patch0: %{name}-%{version}-noopenvms.patch
Patch1: %{name}-%{version}-iterator_variable.patch
Patch2: %{name}-%{version}-destdir.patch
Patch3: %{name}-%{version}-usrmove.patch
-Patch4: %{name}-%{version}-gcc.patch
+## FIXME change RTL version not hardcore it
+Patch4: %{name}-%{version}-gcc5.patch
BuildRequires: xmlada-devel
BuildRequires: gcc-gnat > 5.0
@@ -40,14 +41,13 @@ and libraries and is particularly well-suited for compiled languages.
%patch1 -p1
%patch2 -p1
%patch3 -p1
-%patch4 -p1
+%patch4 -p1
# Update the various config.guess to upstream release for new arch support
cp /usr/lib/rpm/config.* .
%build
%configure --disable-rpath --datadir="%{buildroot}/%{_datadir}" --libdir="%{buildroot}/%{_libdir}" --bindir="%{buildroot}/%{_bindir}" --libexecdir="%{buildroot}/%{_libexecdir}"
-export GPRLIB_DEBUG="TRUE"
make %{?_smp_mflags} LIBRARY_TYPE="relocatable" GNATOPTFLAGS="%{Gnatmake_optflags}" ADA_PROJECT_PATH=%_GNAT_project_dir
%install
@@ -71,10 +71,9 @@ rm -rf %{buildroot}/%{_datadir}/doc/%{name}
%_GNAT_project_dir/*
%changelog
-
-* Tue Feb 17 2015 Pavel Zhukov <landgraf at fedoraproject.org> - 2014-3
-- New release 2014
-- Update gnat directory with gcc-5.0 headers
+* Sun Mar 29 2015 Pavel Zhukov <landgraf at fedoraproject.org> - 2014-4
+- New release (2014)
+- Fix library version
* Sun Feb 15 2015 Pavel Zhukov <landgraf at fedoraproject.org> - 2013-16
- Remove OpenVMS from supported OS
--
cgit v0.10.2
http://pkgs.fedoraproject.org/cgit/gprbuild.git/commit/?h=master&id=f10e5346d81a0c9f97cadd9d24539c4920c40cb4
More information about the scm-commits
mailing list