[multiple changes]

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Process_Convention): Move Stdcall tests to
	Set_Convention_From_Pragma so that they are applied to each
	entry of a homonym set.
	(Process_Convention): Don't try to set convention if already set.

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* gnatbind.adb: Minor reformatting.

2013-04-24  Vincent Celier  <celier@adacore.com>

	* clean.adb (Gnatclean): Add the default project search
	directories in the project search path after scanning the
	switches on the command line.
	(Initialize): Do not put the default project search directories in the
	project search path.
	* gnatcmd.adb (GNATcmd): Add the default project search
	directories in the project search path after scanning the switches
	on the command line.
	* make.adb (Initialize): Add the default project search
	directories in the project search path after scanning the switches
	on the command line.

2013-04-24  Yannick Moy  <moy@adacore.com>

	* restrict.ads (Restriction_Warnings): Initialize with all False value.

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* checks.ads, checks.adb (Predicate_Checks_Suppressed): New function.
	* exp_util.ads, exp_util.adb (Make_Predicate_Check): Check setting of
	Predicate_Check.
	* snames.ads-tmpl (Name_Predicate_Check): New check name.
	* types.ads (Predicate_Check): New definition.
	* gnat_rm.texi: Add documentation for Predicate_Check.

From-SVN: r198226

gcc/ada/ChangeLog

+2013-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* sem_prag.adb (Process_Convention): Move Stdcall tests to
+	Set_Convention_From_Pragma so that they are applied to each
+	entry of a homonym set.
+	(Process_Convention): Don't try to set convention if already set.
+
+2013-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* gnatbind.adb: Minor reformatting.
+
+2013-04-24  Vincent Celier  <celier@adacore.com>
+
+	* clean.adb (Gnatclean): Add the default project search
+	directories in the project search path after scanning the
+	switches on the command line.
+	(Initialize): Do not put the default project search directories in the
+	project search path.
+	* gnatcmd.adb (GNATcmd): Add the default project search
+	directories in the project search path after scanning the switches
+	on the command line.
+	* make.adb (Initialize): Add the default project search
+	directories in the project search path after scanning the switches
+	on the command line.
+
+2013-04-24  Yannick Moy  <moy@adacore.com>
+
+	* restrict.ads (Restriction_Warnings): Initialize with all False value.
+
+2013-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* checks.ads, checks.adb (Predicate_Checks_Suppressed): New function.
+	* exp_util.ads, exp_util.adb (Make_Predicate_Check): Check setting of
+	Predicate_Check.
+	* snames.ads-tmpl (Name_Predicate_Check): New check name.
+	* types.ads (Predicate_Check): New definition.
+	* gnat_rm.texi: Add documentation for Predicate_Check.
+
 2013-04-24  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): If this

gcc/ada/checks.adb

@@ -7750,6 +7750,19 @@ package body Checks is
       end if;
    end Overflow_Checks_Suppressed;
 
+   ---------------------------------
+   -- Predicate_Checks_Suppressed --
+   ---------------------------------
+
+   function Predicate_Checks_Suppressed (E : Entity_Id) return Boolean is
+   begin
+      if Present (E) and then Checks_May_Be_Suppressed (E) then
+         return Is_Check_Suppressed (E, Predicate_Check);
+      else
+         return Scope_Suppress.Suppress (Predicate_Check);
+      end if;
+   end Predicate_Checks_Suppressed;
+
    -----------------------------
    -- Range_Checks_Suppressed --
    -----------------------------

gcc/ada/checks.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -56,6 +56,7 @@ package Checks is
    function Index_Checks_Suppressed           (E : Entity_Id) return Boolean;
    function Length_Checks_Suppressed          (E : Entity_Id) return Boolean;
    function Overflow_Checks_Suppressed        (E : Entity_Id) return Boolean;
+   function Predicate_Checks_Suppressed       (E : Entity_Id) return Boolean;
    function Range_Checks_Suppressed           (E : Entity_Id) return Boolean;
    function Storage_Checks_Suppressed         (E : Entity_Id) return Boolean;
    function Tag_Checks_Suppressed             (E : Entity_Id) return Boolean;

gcc/ada/clean.adb

@@ -1377,6 +1377,13 @@ package body Clean is
 
       Parse_Cmd_Line;
 
+      --  Add the default project search directories now, after the directories
+      --  that have been specified by switches -aP<dir>.
+
+      Prj.Env.Initialize_Default_Project_Path
+        (Root_Environment.Project_Path,
+         Target_Name => Sdefault.Target_Name.all);
+
       if Verbose_Mode then
          Display_Copyright;
       end if;
@@ -1550,9 +1557,6 @@ package body Clean is
          Snames.Initialize;
 
          Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
-         Prj.Env.Initialize_Default_Project_Path
-            (Root_Environment.Project_Path,
-             Target_Name => Sdefault.Target_Name.all);
 
          Project_Node_Tree := new Project_Node_Tree_Data;
          Prj.Tree.Initialize (Project_Node_Tree);

gcc/ada/exp_util.adb

@@ -46,7 +46,6 @@ with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Eval; use Sem_Eval;
-with Sem_Prag; use Sem_Prag;
 with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
@@ -5472,18 +5471,11 @@ package body Exp_Util is
    begin
       pragma Assert
         (Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)));
-
-      if Check_Kind (Name_Invariant) = Name_Check then
-         return
-           Make_Procedure_Call_Statement (Loc,
-             Name                   =>
-               New_Occurrence_Of (Invariant_Procedure (Typ), Loc),
-             Parameter_Associations => New_List (Relocate_Node (Expr)));
-
-      else
-         return
-           Make_Null_Statement (Loc);
-      end if;
+      return
+        Make_Procedure_Call_Statement (Loc,
+          Name                   =>
+            New_Occurrence_Of (Invariant_Procedure (Typ), Loc),
+          Parameter_Associations => New_List (Relocate_Node (Expr)));
    end Make_Invariant_Call;
 
    ------------------------
@@ -5605,6 +5597,14 @@ package body Exp_Util is
       Nam : Name_Id;
 
    begin
+      --  If predicate checks are suppressed, then return a null statement.
+      --  For this call, we check only the scope setting. If the caller wants
+      --  to check a specific entity's setting, they must do it manually.
+
+      if Predicate_Checks_Suppressed (Empty) then
+         return Make_Null_Statement (Loc);
+      end if;
+
       --  Compute proper name to use, we need to get this right so that the
       --  right set of check policies apply to the Check pragma we are making.
 

gcc/ada/exp_util.ads

@@ -665,8 +665,9 @@ package Exp_Util is
      (Typ  : Entity_Id;
       Expr : Node_Id) return Node_Id;
    --  Typ is a type with Predicate_Function set. This routine builds a Check
-   --  pragma whose first argument is Predicate, and the second argument is a
-   --  call to the this predicate function with Expr as the argument.
+   --  pragma whose first argument is Predicate, and the second argument is
+   --  a call to the predicate function of Typ with Expr as the argument. If
+   --  Predicate_Check is suppressed then a null statement is returned instead.
 
    function Make_Subtype_From_Expr
      (E       : Node_Id;

gcc/ada/gnat_rm.texi

@@ -5628,12 +5628,38 @@ pragma Suppress (Identifier [, [On =>] Name]);
 
 @noindent
 This is a standard pragma, and supports all the check names required in
-the RM. It is included here because GNAT recognizes one additional check
-name: @code{Alignment_Check} which can be used to suppress alignment checks
+the RM. It is included here because GNAT recognizes some additional check
+names that are implementation defined (as permitted by the RM):
+
+@itemize @bullet
+
+@item
+@code{Alignment_Check} can be used to suppress alignment checks
 on addresses used in address clauses. Such checks can also be suppressed
 by suppressing range checks, but the specific use of @code{Alignment_Check}
 allows suppression of alignment checks without suppressing other range checks.
 
+@item
+@code{Predicate_Check} can be used to control whether predicate checks are
+active. It is applicable only to predicates for which the policy is
+@code{Check}. Unlike @code{Assertion_Policy}, which determines if a given
+predicate is ignored or checked for the whole program, the use of
+@code{Suppress} and @code{Unsuppress} with this check name allows a given
+predicate to be turned on and off at specific points in the program.
+
+@item
+@code{Validity_Check} can be used specifically to control validity checks.
+If @code{Suppress} is used to suppress validity checks, then no validity
+checks are performed, including those specified by the appropriate compiler
+switch or the @code{Validity_Checks} pragma.
+
+@item
+Additional check names previously introduced by use of the @code{Check_Name}
+pragma are also allowed.
+
+@end itemize
+
+@noindent
 Note that pragma Suppress gives the compiler permission to omit
 checks, but does not require the compiler to omit checks. The compiler
 will generate checks if they are essentially free, even when they are
@@ -6182,6 +6208,10 @@ checks.
 This pragma is standard in Ada 2005. It is available in all earlier versions
 of Ada as an implementation-defined pragma.
 
+Note that in addition to the checks defined in the Ada RM, GNAT recogizes
+a number of implementation-defined check names. See description of pragma
+@code{Suppress} for full details.
+
 @node Pragma Use_VADS_Size
 @unnumberedsec Pragma Use_VADS_Size
 @cindex @code{Size}, VADS compatibility
@@ -10430,6 +10460,12 @@ The implementation defined check name Alignment_Check controls checking of
 address clause values for proper alignment (that is, the address supplied
 must be consistent with the alignment of the type).
 
+The implementation defined check name Predicate_Check controls whether
+predicate checks are generated.
+
+The implementation defined check name Validity_Check controls whether
+validity checks are generated.
+
 In addition, a user program can add implementation-defined check names
 by means of the pragma Check_Name.
 

gcc/ada/gnatbind.adb

@@ -494,13 +494,14 @@ procedure Gnatbind is
 
    procedure Generic_Scan_Bind_Args is
       Next_Arg : Positive := 1;
+
    begin
-      --  Use low level argument routines to avoid dragging in the secondary
-      --  stack
+      --  Use low level argument routines to avoid dragging in secondary stack
 
       while Next_Arg < Arg_Count loop
          declare
             Next_Argv : String (1 .. Len_Arg (Next_Arg));
+
          begin
             Fill_Arg (Next_Argv'Address, Next_Arg);
 
@@ -531,6 +532,10 @@ procedure Gnatbind is
       end loop;
    end Generic_Scan_Bind_Args;
 
+   ---------------
+   -- Write_Arg --
+   ---------------
+
    procedure Write_Arg (S : String) is
    begin
       Write_Str (" " & S);
@@ -545,7 +550,6 @@ procedure Gnatbind is
 --  Start of processing for Gnatbind
 
 begin
-
    --  Set default for Shared_Libgnat option
 
    declare

gcc/ada/gnatcmd.adb

@@ -1395,9 +1395,6 @@ begin
    Snames.Initialize;
 
    Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
-   Prj.Env.Initialize_Default_Project_Path
-     (Root_Environment.Project_Path,
-      Target_Name => Sdefault.Target_Name.all);
 
    Project_Node_Tree := new Project_Node_Tree_Data;
    Prj.Tree.Initialize (Project_Node_Tree);
@@ -1911,6 +1908,13 @@ begin
          end Inspect_Switches;
       end if;
 
+      --  Add the default project search directories now, after the directories
+      --  that have been specified by switches -aP<dir>.
+
+      Prj.Env.Initialize_Default_Project_Path
+        (Root_Environment.Project_Path,
+         Target_Name => Sdefault.Target_Name.all);
+
       --  If there is a project file specified, parse it, get the switches
       --  for the tool and setup PATH environment variables.
 

gcc/ada/make.adb

@@ -6392,8 +6392,6 @@ package body Make is
       --  the command line switches
 
       Prj.Tree.Initialize (Env, Gnatmake_Flags);
-      Prj.Env.Initialize_Default_Project_Path
-        (Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
 
       Project_Node_Tree := new Project_Node_Tree_Data;
       Prj.Tree.Initialize (Project_Node_Tree);
@@ -6492,6 +6490,12 @@ package body Make is
          Usage;
       end if;
 
+      --  Add the default project search directories now, after the directories
+      --  that have been specified by switches -aP<dir>.
+
+      Prj.Env.Initialize_Default_Project_Path
+        (Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
+
       --  Test for trailing -P switch
 
       if Project_File_Name_Present and then Project_File_Name = null then

gcc/ada/restrict.ads

@@ -62,7 +62,7 @@ package Restrict is
    --  since we want the binder to be able to accurately diagnose inter-unit
    --  restriction violations.
 
-   Restriction_Warnings : Rident.Restriction_Flags;
+   Restriction_Warnings : Rident.Restriction_Flags := (others => False);
    --  If one of these flags is set, then it means that violation of the
    --  corresponding restriction results only in a warning message, not
    --  in an error message, and the restriction is not otherwise enforced.

gcc/ada/sem_prag.adb

@@ -4928,6 +4928,51 @@ package body Sem_Prag is
                   & "operation", Arg1);
             end if;
 
+            --  Special checks for Convention_Stdcall
+
+            if C = Convention_Stdcall then
+
+               --  A dispatching call is not allowed. A dispatching subprogram
+               --  cannot be used to interface to the Win32 API, so in fact
+               --  this check does not impose any effective restriction.
+
+               if Is_Dispatching_Operation (E) then
+                  Error_Msg_Sloc := Sloc (E);
+
+                  --  Note: make this unconditional so that if there is more
+                  --  than one call to which the pragma applies, we get a
+                  --  message for each call. Also don't use Error_Pragma,
+                  --  so that we get multiple messages!
+
+                  Error_Msg_N
+                    ("dispatching subprogram# cannot use Stdcall convention!",
+                     Arg1);
+
+               --  Subprogram is allowed, but not a generic subprogram
+
+               elsif not Is_Subprogram (E)
+                 and then not Is_Generic_Subprogram (E)
+
+                 --  A variable is OK
+
+                 and then Ekind (E) /= E_Variable
+
+                 --  An access to subprogram is also allowed
+
+                 and then not
+                   (Is_Access_Type (E)
+                     and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
+
+                 --  Allow internal call to set convention of subprogram type
+
+                 and then not (Ekind (E) = E_Subprogram_Type)
+               then
+                  Error_Pragma_Arg
+                    ("second argument of pragma% must be subprogram (type)",
+                     Arg2);
+               end if;
+            end if;
+
             --  Set the convention
 
             Set_Convention (E, C);
@@ -5158,40 +5203,7 @@ package body Sem_Prag is
               ("second argument of pragma% must be a subprogram", Arg2);
          end if;
 
-         --  Stdcall case
-
-         if C = Convention_Stdcall then
-
-            --  A dispatching call is not allowed. A dispatching subprogram
-            --  cannot be used to interface to the Win32 API, so in fact this
-            --  check does not impose any effective restriction.
-
-            if Is_Dispatching_Operation (E) then
-
-               Error_Pragma
-                 ("dispatching subprograms cannot use Stdcall convention");
-
-            --  Subprogram is allowed, but not a generic subprogram, and not a
-            --  dispatching operation.
-
-            elsif not Is_Subprogram (E)
-              and then not Is_Generic_Subprogram (E)
-
-              --  A variable is OK
-
-              and then Ekind (E) /= E_Variable
-
-              --  An access to subprogram is also allowed
-
-              and then not
-                (Is_Access_Type (E)
-                  and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
-            then
-               Error_Pragma_Arg
-                 ("second argument of pragma% must be subprogram (type)",
-                  Arg2);
-            end if;
-         end if;
+         --  Deal with non-subprogram cases
 
          if not Is_Subprogram (E)
            and then not Is_Generic_Subprogram (E)
@@ -5202,7 +5214,7 @@ package body Sem_Prag is
                Check_First_Subtype (Arg2);
                Set_Convention_From_Pragma (Base_Type (E));
 
-               --  For subprograms, we must set the convention on the
+               --  For access subprograms, we must set the convention on the
                --  internally generated directly designated type as well.
 
                if Ekind (E) = E_Access_Subprogram_Type then
@@ -5251,6 +5263,12 @@ package body Sem_Prag is
                E1 := Homonym (E1);
                exit when No (E1) or else Scope (E1) /= Current_Scope;
 
+               --  Ignore entry for which convention is already set
+
+               if Has_Convention_Pragma (E1) then
+                  goto Continue;
+               end if;
+
                --  Do not set the pragma on inherited operations or on formal
                --  subprograms.
 
@@ -5274,6 +5292,9 @@ package body Sem_Prag is
                      Generate_Reference (E1, Id, 'b');
                   end if;
                end if;
+
+            <<Continue>>
+               null;
             end loop;
          end if;
       end Process_Convention;

gcc/ada/snames.ads-tmpl

@@ -1082,6 +1082,7 @@ package Snames is
    Name_Index_Check                    : constant Name_Id := N + $;
    Name_Length_Check                   : constant Name_Id := N + $;
    Name_Overflow_Check                 : constant Name_Id := N + $;
+   Name_Predicate_Check                : constant Name_Id := N + $; -- GNAT
    Name_Range_Check                    : constant Name_Id := N + $;
    Name_Storage_Check                  : constant Name_Id := N + $;
    Name_Tag_Check                      : constant Name_Id := N + $;

gcc/ada/types.ads

@@ -666,15 +666,16 @@ package Types is
    Index_Check            : constant :=  8;
    Length_Check           : constant :=  9;
    Overflow_Check         : constant := 10;
-   Range_Check            : constant := 11;
-   Storage_Check          : constant := 12;
-   Tag_Check              : constant := 13;
-   Validity_Check         : constant := 14;
+   Predicate_Check        : constant := 11;
+   Range_Check            : constant := 12;
+   Storage_Check          : constant := 13;
+   Tag_Check              : constant := 14;
+   Validity_Check         : constant := 15;
    --  Values used to represent individual predefined checks (including the
    --  setting of Atomic_Synchronization, which is implemented internally using
-   --  a "check" whose name is Atomic_Synchronization.
+   --  a "check" whose name is Atomic_Synchronization).
 
-   All_Checks : constant := 15;
+   All_Checks : constant := 16;
    --  Value used to represent All_Checks value
 
    subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;