2004-06-14 Pascal Obry <obry@gnat.com>

	* gnat_ugn.texi: Document relocatable vs. dynamic Library_Kind on
	Windows.  Fix minor typo.

	* mlib-tgt-mingw.adb: New implementation using the GCC -shared option
	which is now supported on Windows. With this implementation using the
	Library Project feature is no different on Windows than on UNIX.

2004-06-14  Vincent Celier  <celier@gnat.com>

	* makegpr.adb (Compile_Sources): Nothing to do when there are no
	non-Ada sources.

	* mlib-tgt-vxworks.adb (Library_Exists_For): Remove incorrect comment

	* prj-part.adb (Parse_Single_Project): When a duplicate project name is
	found, show the project name and the path of the previously parsed
	project file.

2004-06-14  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Add_Call_By_Copy_Code): For an out-parameter that is an
	array, avoid copying the actual before the call.

2004-06-14  Thomas Quinot  <quinot@act-europe.fr>

	* g-debpoo.adb: Remove alignment assumptions from GNAT.Debug_Pools.
	Instead, allocate memory on worst-case alignment assumptions, and then
	return an aligned address within the allocated zone.

2004-06-14  Robert Dewar  <dewar@gnat.com>

	* bindgen.adb (Gen_Adainit_Ada): Do not generate external references to
	elab entities in predefined units in No_Run_Time_Mode.
	(Gen_Adainit_C): Same fix
	(Gen_Elab_Calls_Ada): Do not generate calls to elaborate predefined
	units in No_Run_Time_Mode
	(Gen_Elab_Calls_C): Same fix

	* symbols-vms-alpha.adb: Minor reformatting

	* g-debpoo.ads: Minor reformatting

	* lib.adb (In_Same_Extended_Unit): Version working on node id's

	* lib.ads (In_Same_Extended_Unit): Version working on node id's

	* lib-xref.adb: Minor cleanup, use new version of In_Same_Extended_Unit
	working on nodes.

	* make.adb: Minor reformatting

	* par-ch12.adb: Minor reformatting

	* par-prag.adb: Add dummy entry for pragma Profile_Warnings

	* prj-strt.adb: Minor reformatting

	* restrict.ads, restrict.adb: Redo handling of profile restrictions to
	be more general.

	* sem_attr.adb: Minor reformatting

	* sem_ch7.adb: Minor reformatting

	* sem_elab.adb (Check_A_Call): Deal with problem of calling init proc
	for type in the same unit as the object declaration.

	* sem_prag.adb (Check_Arg_Is_External_Name): New procedure, allows
	static string expressions and not just string literals.
	Minor reformatting
	(Set_Warning): Reset restriction warning flag for restriction pragma
	Implement pragma Profile_Warnings
	Implement pragma Profile (Restricted)
	Give obolescent messages for old restrictions and pragmas

	* snames.h, snames.ads, snames.adb: Add new entry for pragma
	Profile_Warnings.

	* s-rident.ads: Add declarations for restrictions required by profile
	Restricted and profile Ravenscar.

	* targparm.ads, targparm.adb: Allow pragma Profile in system.ads

	* gnat_ugn.texi: Correct some missing entries in the list of GNAT
	configuration pragmas.


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

1 files changed, 121 insertions, 21 deletions

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8501a71c72c..0d8c1e1861e 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -244,6 +244,12 @@ package body Sem_Prag is
       --  in which case the check is applied to the expression of the
       --  association or an expression directly.
 
+      procedure Check_Arg_Is_External_Name (Arg : Node_Id);
+      --  Check that an argument has the right form for an EXTERNAL_NAME
+      --  parameter of an extended import/export pragma. The rule is that
+      --  the name must be an identifier or string literal (in Ada 83 mode)
+      --  or a static string expression (in Ada 95 mode).
+
       procedure Check_Arg_Is_Identifier (Arg : Node_Id);
       --  Check the specified argument Arg to make sure that it is an
       --  identifier. If not give error and raise Pragma_Exit.
@@ -589,13 +595,61 @@ package body Sem_Prag is
          end if;
       end Check_Arg_Count;
 
+      --------------------------------
+      -- Check_Arg_Is_External_Name --
+      --------------------------------
+
+      procedure Check_Arg_Is_External_Name (Arg : Node_Id) is
+         Argx : constant Node_Id := Get_Pragma_Arg (Arg);
+
+      begin
+         if Nkind (Argx) = N_Identifier then
+            return;
+
+         else
+            Analyze_And_Resolve (Argx, Standard_String);
+
+            if Is_OK_Static_Expression (Argx) then
+               return;
+
+            elsif Etype (Argx) = Any_Type then
+               raise Pragma_Exit;
+
+            --  An interesting special case, if we have a string literal and
+            --  we are in Ada 83 mode, then we allow it even though it will
+            --  not be flagged as static. This allows expected Ada 83 mode
+            --  use of external names which are string literals, even though
+            --  technically these are not static in Ada 83.
+
+            elsif Ada_Version = Ada_83
+              and then Nkind (Argx) = N_String_Literal
+            then
+               return;
+
+            --  Static expression that raises Constraint_Error. This has
+            --  already been flagged, so just exit from pragma processing.
+
+            elsif Is_Static_Expression (Argx) then
+               raise Pragma_Exit;
+
+            --  Here we have a real error (non-static expression)
+
+            else
+               Error_Msg_Name_1 := Chars (N);
+               Flag_Non_Static_Expr
+                 ("argument for pragma% must be a identifier or " &
+                  "static string expression!", Argx);
+               raise Pragma_Exit;
+            end if;
+         end if;
+      end Check_Arg_Is_External_Name;
+
       -----------------------------
       -- Check_Arg_Is_Identifier --
       -----------------------------
 
       procedure Check_Arg_Is_Identifier (Arg : Node_Id) is
          Argx : constant Node_Id := Get_Pragma_Arg (Arg);
-
       begin
          if Nkind (Argx) /= N_Identifier then
             Error_Pragma_Arg
@@ -609,7 +663,6 @@ package body Sem_Prag is
 
       procedure Check_Arg_Is_Integer_Literal (Arg : Node_Id) is
          Argx : constant Node_Id := Get_Pragma_Arg (Arg);
-
       begin
          if Nkind (Argx) /= N_Integer_Literal then
             Error_Pragma_Arg
@@ -2084,13 +2137,8 @@ package body Sem_Prag is
 
          Set_Extended_Import_Export_External_Name (Def_Id, Arg_External);
 
-         if Present (Arg_Size)
-           and then Nkind (Arg_Size) /= N_Identifier
-           and then Nkind (Arg_Size) /= N_String_Literal
-         then
-            Error_Pragma_Arg
-              ("pragma% Size argument must be identifier or string literal",
-               Arg_Size);
+         if Present (Arg_Size) then
+            Check_Arg_Is_External_Name (Arg_Size);
          end if;
 
          --  Export_Object case
@@ -3271,7 +3319,8 @@ package body Sem_Prag is
          Val   : Uint;
 
          procedure Set_Warning (R : All_Restrictions);
-         --  If this is a Restriction_Warnings pragma, set warning flag
+         --  If this is a Restriction_Warnings pragma, set warning flag,
+         --  otherwise reset the flag.
 
          -----------------
          -- Set_Warning --
@@ -3281,6 +3330,8 @@ package body Sem_Prag is
          begin
             if Prag_Id = Pragma_Restriction_Warnings then
                Restriction_Warnings (R) := True;
+            else
+               Restriction_Warnings (R) := False;
             end if;
          end Set_Warning;
 
@@ -3306,7 +3357,7 @@ package body Sem_Prag is
 
                R_Id :=
                  Get_Restriction_Id
-                   (Process_Restriction_Synonyms (Chars (Expr)));
+                   (Process_Restriction_Synonyms (Expr));
 
                if R_Id not in All_Boolean_Restrictions then
                   Error_Pragma_Arg
@@ -3334,7 +3385,7 @@ package body Sem_Prag is
             --  Case of restriction identifier present
 
             else
-               R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Id));
+               R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg));
                Analyze_And_Resolve (Expr, Any_Integer);
 
                if R_Id not in All_Parameter_Restrictions then
@@ -3609,8 +3660,11 @@ package body Sem_Prag is
       begin
          if No (Arg_External) then
             return;
+         end if;
+
+         Check_Arg_Is_External_Name (Arg_External);
 
-         elsif Nkind (Arg_External) = N_String_Literal then
+         if Nkind (Arg_External) = N_String_Literal then
             if String_Length (Strval (Arg_External)) = 0 then
                return;
             else
@@ -3620,10 +3674,12 @@ package body Sem_Prag is
          elsif Nkind (Arg_External) = N_Identifier then
             New_Name := Get_Default_External_Name (Arg_External);
 
+         --  Check_Arg_Is_External_Name should let through only
+         --  identifiers and string literals or static string
+         --  expressions (which are folded to string literals).
+
          else
-            Error_Pragma_Arg
-              ("incorrect form for External parameter for pragma%",
-               Arg_External);
+            raise Program_Error;
          end if;
 
          --  If we already have an external name set (by a prior normal
@@ -3848,7 +3904,7 @@ package body Sem_Prag is
 
       --    Set Detect_Blocking mode ???
 
-      --    Set required restrictions (see Restrict.Set_Ravenscar for details)
+      --    Set required restrictions (see System.Rident for detailed list)
 
       procedure Set_Ravenscar_Profile (N : Node_Id) is
       begin
@@ -3896,7 +3952,7 @@ package body Sem_Prag is
 
          --  Set the corresponding restrictions
 
-         Set_Ravenscar (N);
+         Set_Profile_Restrictions (Ravenscar, N, Warn => False);
       end Set_Ravenscar_Profile;
 
    --  Start of processing for Analyze_Pragma
@@ -8095,10 +8151,9 @@ package body Sem_Prag is
 
          --  pragma Profile (profile_IDENTIFIER);
 
-         --  profile_IDENTIFIER => Ravenscar
+         --  profile_IDENTIFIER => Protected | Ravenscar
 
          when Pragma_Profile =>
-            GNAT_Pragma;
             Check_Arg_Count (1);
             Check_Valid_Configuration_Pragma;
             Check_No_Identifiers;
@@ -8108,6 +8163,36 @@ package body Sem_Prag is
             begin
                if Chars (Argx) = Name_Ravenscar then
                   Set_Ravenscar_Profile (N);
+
+               elsif Chars (Argx) = Name_Restricted then
+                  Set_Profile_Restrictions (Restricted, N, Warn => False);
+               else
+                  Error_Pragma_Arg ("& is not a valid profile", Argx);
+               end if;
+            end;
+
+         ----------------------
+         -- Profile_Warnings --
+         ----------------------
+
+         --  pragma Profile_Warnings (profile_IDENTIFIER);
+
+         --  profile_IDENTIFIER => Protected | Ravenscar
+
+         when Pragma_Profile_Warnings =>
+            GNAT_Pragma;
+            Check_Arg_Count (1);
+            Check_Valid_Configuration_Pragma;
+            Check_No_Identifiers;
+
+            declare
+               Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
+            begin
+               if Chars (Argx) = Name_Ravenscar then
+                  Set_Profile_Restrictions (Ravenscar, N, Warn => True);
+
+               elsif Chars (Argx) = Name_Restricted then
+                  Set_Profile_Restrictions (Restricted, N, Warn => True);
                else
                   Error_Pragma_Arg ("& is not a valid profile", Argx);
                end if;
@@ -8579,6 +8664,13 @@ package body Sem_Prag is
             Check_Valid_Configuration_Pragma;
             Set_Ravenscar_Profile (N);
 
+            if Warn_On_Obsolescent_Feature then
+               Error_Msg_N
+                 ("pragma Ravenscar is an obsolescent feature?", N);
+               Error_Msg_N
+                 ("|use pragma Profile (Ravenscar) instead", N);
+            end if;
+
          -------------------------
          -- Restricted_Run_Time --
          -------------------------
@@ -8589,7 +8681,14 @@ package body Sem_Prag is
             GNAT_Pragma;
             Check_Arg_Count (0);
             Check_Valid_Configuration_Pragma;
-            Set_Restricted_Profile (N);
+            Set_Profile_Restrictions (Restricted, N, Warn => False);
+
+            if Warn_On_Obsolescent_Feature then
+               Error_Msg_N
+                 ("pragma Restricted_Run_Time is an obsolescent feature?", N);
+               Error_Msg_N
+                 ("|use pragma Profile (Restricted) instead", N);
+            end if;
 
          ------------------
          -- Restrictions --
@@ -10158,6 +10257,7 @@ package body Sem_Prag is
       Pragma_Preelaborate                 => -1,
       Pragma_Priority                     => -1,
       Pragma_Profile                      =>  0,
+      Pragma_Profile_Warnings             =>  0,
       Pragma_Propagate_Exceptions         => -1,
       Pragma_Psect_Object                 => -1,
       Pragma_Pure                         =>  0,