[multiple changes]

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* sprint.adb: Minor reformatting.

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Do required predicate
	checks.
	* sem_ch3.adb (Complete_Private_Subtype): Propagate predicates to full
	view.
	* sem_ch6.adb (Invariants_Or_Predicates_Present): New name for
	Invariants_Present.
	(Process_PPCs): Handle predicates generating post conditions
	* sem_util.adb (Is_Partially_Initialized_Type): Add
	Include_Null parameter.
	* sem_util.ads (Is_Partially_Initialized_Type): Add
	Include_Null parameter.

2010-10-22  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi (gnatelim): Add description for '--ignore' option

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb (Check_First_Subtype): Specialize error messages for
	case where argument is not a type.

From-SVN: r165815

gcc/ada/ChangeLog

 2010-10-22  Robert Dewar  <dewar@adacore.com>
 
+	* sprint.adb: Minor reformatting.
+
+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): Do required predicate
+	checks.
+	* sem_ch3.adb (Complete_Private_Subtype): Propagate predicates to full
+	view.
+	* sem_ch6.adb (Invariants_Or_Predicates_Present): New name for
+	Invariants_Present.
+	(Process_PPCs): Handle predicates generating post conditions
+	* sem_util.adb (Is_Partially_Initialized_Type): Add
+	Include_Null parameter.
+	* sem_util.ads (Is_Partially_Initialized_Type): Add
+	Include_Null parameter.
+
+2010-10-22  Sergey Rybin  <rybin@adacore.com>
+
+	* gnat_ugn.texi (gnatelim): Add description for '--ignore' option
+
+2010-10-22  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_prag.adb (Check_First_Subtype): Specialize error messages for
+	case where argument is not a type.
+
+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
 	* exp_ch5.adb, par-ch4.adb, par-ch5.adb, sem_ch5.adb, sinfo.ads: Minor
 	reformatting.
 

gcc/ada/exp_ch3.adb

@@ -4508,6 +4508,24 @@ package body Exp_Ch3 is
          return;
       end if;
 
+      --  Deal with predicate check before we start to do major rewriting.
+      --  it is OK to initialize and then check the initialized value, since
+      --  the object goes out of scope if we get a predicate failure.
+
+      --  We need a predicate check if the type has predicates, and if either
+      --  there is an initializing expression, or for default initialization
+      --  when we have at least one case of an explicit default initial value.
+
+      if Present (Predicate_Function (Typ))
+        and then
+          (Present (Expr)
+            or else
+              Is_Partially_Initialized_Type (Typ, Include_Null => False))
+      then
+         Insert_After (N,
+           Make_Predicate_Check (Typ, New_Occurrence_Of (Def_Id, Loc)));
+      end if;
+
       --  Force construction of dispatch tables of library level tagged types
 
       if Tagged_Type_Expansion

gcc/ada/gnat_ugn.texi

@@ -10911,6 +10911,11 @@ Duplicate all the output sent to @file{stderr} into a specified log file.
 @item ^--no-elim-dispatch^/NO_DISPATCH^
 Do not generate pragmas for dispatching operations.
 
+@item ^--ignore^/IGNORE^=@var{filename}
+@cindex @option{^--ignore^/IGNORE^} (@command{gnatelim})
+Do not generate pragmas for subprograms declared in the sources
+listed in a specified file
+
 @cindex @option{^-o^/OUTPUT^} (@command{gnatelim})
 @item ^-o^/OUTPUT^=@var{report_file}
 Put @command{gnatelim} output into a specified file. If this file already exists,

gcc/ada/sem_ch3.adb

@@ -9913,6 +9913,13 @@ package body Sem_Ch3 is
               Corresponding_Record_Type (Full_Base));
          end if;
       end if;
+
+      --  Copy rep item chain, and also setting of Has_Predicates from
+      --  private subtype to full subtype, since we will need these on the
+      --  full subtype to create the predicate function.
+
+      Set_First_Rep_Item (Full, First_Rep_Item (Priv));
+      Set_Has_Predicates (Full, Has_Predicates (Priv));
    end Complete_Private_Subtype;
 
    ----------------------------

gcc/ada/sem_ch6.adb

@@ -207,8 +207,8 @@ package body Sem_Ch6 is
    --  conditions for the body and assembling and inserting the _postconditions
    --  procedure. N is the node for the subprogram body and Body_Id/Spec_Id are
    --  the entities for the body and separate spec (if there is no separate
-   --  spec, Spec_Id is Empty). Note that invariants also provide a source
-   --  of postconditions, which are also handled in this procedure.
+   --  spec, Spec_Id is Empty). Note that invariants and predicates may also
+   --  provide postconditions, and are also handled in this procedure.
 
    procedure Set_Formal_Validity (Formal_Id : Entity_Id);
    --  Formal_Id is an formal parameter entity. This procedure deals with
@@ -8681,9 +8681,10 @@ package body Sem_Ch6 is
       --  references to parameters of the inherited subprogram to point to the
       --  corresponding parameters of the current subprogram.
 
-      function Invariants_Present return Boolean;
-      --  Determines if any invariants are present for any OUT or IN OUT
-      --  parameters of the subprogram, or (for a function) for the return.
+      function Invariants_Or_Predicates_Present return Boolean;
+      --  Determines if any invariants or predicates are present for any OUT
+      --  or IN OUT parameters of the subprogram, or (for a function) if the
+      --  return value has an invariant.
 
       --------------
       -- Grab_PPC --
@@ -8782,12 +8783,12 @@ package body Sem_Ch6 is
          return CP;
       end Grab_PPC;
 
-      ------------------------
-      -- Invariants_Present --
-      ------------------------
+      --------------------------------------
+      -- Invariants_Or_Predicates_Present --
+      --------------------------------------
 
-      function Invariants_Present return Boolean is
-         Formal     : Entity_Id;
+      function Invariants_Or_Predicates_Present return Boolean is
+         Formal : Entity_Id;
 
       begin
          --  Check function return result
@@ -8803,7 +8804,9 @@ package body Sem_Ch6 is
          Formal := First_Formal (Designator);
          while Present (Formal) loop
             if Ekind (Formal) /= E_In_Parameter
-              and then Has_Invariants (Etype (Formal))
+              and then
+                (Has_Invariants (Etype (Formal))
+                  or else Present (Predicate_Function (Etype (Formal))))
             then
                return True;
             end if;
@@ -8812,7 +8815,7 @@ package body Sem_Ch6 is
          end loop;
 
          return False;
-      end Invariants_Present;
+      end Invariants_Or_Predicates_Present;
 
    --  Start of processing for Process_PPCs
 
@@ -9084,7 +9087,7 @@ package body Sem_Ch6 is
       --  If we had any postconditions and expansion is enabled, or if the
       --  procedure has invariants, then build the _Postconditions procedure.
 
-      if (Present (Plist) or else Invariants_Present)
+      if (Present (Plist) or else Invariants_Or_Predicates_Present)
         and then Expander_Active
       then
          if No (Plist) then
@@ -9127,21 +9130,33 @@ package body Sem_Ch6 is
             Parms := No_List;
          end if;
 
-         --  Add invariant calls for parameters. Note that this is done for
-         --  functions as well, since in Ada 2012 they can have IN OUT args.
+         --  Add invariant calls and predicate calls for parameters. Note that
+         --  this is done for functions as well, since in Ada 2012 they can
+         --  have IN OUT args.
 
          declare
             Formal : Entity_Id;
+            Ftype  : Entity_Id;
 
          begin
             Formal := First_Formal (Designator);
             while Present (Formal) loop
-               if Ekind (Formal) /= E_In_Parameter
-                 and then Has_Invariants (Etype (Formal))
-                 and then Present (Invariant_Procedure (Etype (Formal)))
-               then
-                  Append_To (Plist,
-                    Make_Invariant_Call (New_Occurrence_Of (Formal, Loc)));
+               if Ekind (Formal) /= E_In_Parameter then
+                  Ftype := Etype (Formal);
+
+                  if Has_Invariants (Ftype)
+                    and then Present (Invariant_Procedure (Ftype))
+                  then
+                     Append_To (Plist,
+                       Make_Invariant_Call
+                         (New_Occurrence_Of (Formal, Loc)));
+                  end if;
+
+                  if Present (Predicate_Function (Ftype)) then
+                     Append_To (Plist,
+                       Make_Predicate_Check
+                         (Ftype, New_Occurrence_Of (Formal, Loc)));
+                  end if;
                end if;
 
                Next_Formal (Formal);
@@ -9365,6 +9380,7 @@ package body Sem_Ch6 is
          if Ekind (Scope (Formal_Id)) = E_Function
            or else Ekind (Scope (Formal_Id)) = E_Generic_Function
          then
+            --  [IN] OUT parameters allowed for functions in Ada 2012
 
             if Ada_Version >= Ada_2012 then
                if In_Present (Spec) then
@@ -9373,6 +9389,8 @@ package body Sem_Ch6 is
                   Set_Ekind (Formal_Id, E_Out_Parameter);
                end if;
 
+            --  But not in earlier versions of Ada
+
             else
                Error_Msg_N ("functions can only have IN parameters", Spec);
                Set_Ekind (Formal_Id, E_In_Parameter);

gcc/ada/sem_prag.adb

@@ -410,8 +410,8 @@ package body Sem_Prag is
       --  case, and if found, issues an appropriate error message.
 
       procedure Check_First_Subtype (Arg : Node_Id);
-      --  Checks that Arg, whose expression is an entity name referencing a
-      --  subtype, does not reference a type that is not a first subtype.
+      --  Checks that Arg, whose expression is an entity name, references a
+      --  first subtype.
 
       procedure Check_In_Main_Program;
       --  Common checks for pragmas that appear within a main program
@@ -976,8 +976,7 @@ package body Sem_Prag is
          Check_Arg_Is_Identifier (Argx);
 
          if not Is_Locking_Policy_Name (Chars (Argx)) then
-            Error_Pragma_Arg
-              ("& is not a valid locking policy name", Argx);
+            Error_Pragma_Arg ("& is not a valid locking policy name", Argx);
          end if;
       end Check_Arg_Is_Locking_Policy;
 
@@ -1032,7 +1031,6 @@ package body Sem_Prag is
             Error_Pragma_Arg ("invalid argument for pragma%", Argx);
          end if;
       end Check_Arg_Is_One_Of;
-
       ---------------------------------
       -- Check_Arg_Is_Queuing_Policy --
       ---------------------------------
@@ -1044,8 +1042,7 @@ package body Sem_Prag is
          Check_Arg_Is_Identifier (Argx);
 
          if not Is_Queuing_Policy_Name (Chars (Argx)) then
-            Error_Pragma_Arg
-              ("& is not a valid queuing policy name", Argx);
+            Error_Pragma_Arg ("& is not a valid queuing policy name", Argx);
          end if;
       end Check_Arg_Is_Queuing_Policy;
 
@@ -1210,9 +1207,7 @@ package body Sem_Prag is
             S : Entity_Id := Id;
 
          begin
-            while Present (S)
-              and then S /= Standard_Standard
-            loop
+            while Present (S) and then S /= Standard_Standard loop
                if Ekind (S) = E_Generic_Package
                  and then In_Package_Body (S)
                then
@@ -1342,10 +1337,22 @@ package body Sem_Prag is
 
       procedure Check_First_Subtype (Arg : Node_Id) is
          Argx : constant Node_Id := Get_Pragma_Arg (Arg);
+         Ent  : constant Entity_Id := Entity (Argx);
       begin
-         if not Is_First_Subtype (Entity (Argx)) then
+         if Is_First_Subtype (Ent) then
+            null;
+
+         elsif Is_Type (Ent) then
             Error_Pragma_Arg
               ("pragma% cannot apply to subtype", Argx);
+
+         elsif Is_Object (Ent) then
+            Error_Pragma_Arg
+              ("pragma% cannot apply to object, requires a type", Argx);
+
+         else
+            Error_Pragma_Arg
+              ("pragma% cannot apply to&, requires a type", Argx);
          end if;
       end Check_First_Subtype;
 
@@ -2188,6 +2195,7 @@ package body Sem_Prag is
 
             if Error_Msg_Name_1 = Name_Precondition then
                Error_Msg_Name_1 := Name_Pre;
+
             elsif Error_Msg_Name_1 = Name_Postcondition then
                Error_Msg_Name_1 := Name_Post;
             end if;

gcc/ada/sem_util.adb

@@ -6776,19 +6776,24 @@ package body Sem_Util is
    -- Is_Partially_Initialized_Type --
    -----------------------------------
 
-   function Is_Partially_Initialized_Type (Typ : Entity_Id) return Boolean is
+   function Is_Partially_Initialized_Type
+     (Typ          : Entity_Id;
+      Include_Null : Boolean := True) return Boolean
+   is
    begin
       if Is_Scalar_Type (Typ) then
          return False;
 
       elsif Is_Access_Type (Typ) then
-         return True;
+         return Include_Null;
 
       elsif Is_Array_Type (Typ) then
 
          --  If component type is partially initialized, so is array type
 
-         if Is_Partially_Initialized_Type (Component_Type (Typ)) then
+         if Is_Partially_Initialized_Type
+              (Component_Type (Typ), Include_Null)
+         then
             return True;
 
          --  Otherwise we are only partially initialized if we are fully
@@ -6841,7 +6846,9 @@ package body Sem_Util is
                      --  If a component is of a type which is itself partially
                      --  initialized, then the enclosing record type is also.
 
-                     elsif Is_Partially_Initialized_Type (Etype (Ent)) then
+                     elsif Is_Partially_Initialized_Type
+                             (Etype (Ent), Include_Null)
+                     then
                         return True;
                      end if;
                   end if;
@@ -6880,7 +6887,7 @@ package body Sem_Util is
             if No (U) then
                return True;
             else
-               return Is_Partially_Initialized_Type (U);
+               return Is_Partially_Initialized_Type (U, Include_Null);
             end if;
          end;
 

gcc/ada/sem_util.ads

@@ -760,12 +760,18 @@ package Sem_Util is
    --  the Is_Variable sense) with a non-tagged type target are considered view
    --  conversions and hence variables.
 
-   function Is_Partially_Initialized_Type (Typ : Entity_Id) return Boolean;
+   function Is_Partially_Initialized_Type
+     (Typ          : Entity_Id;
+      Include_Null : Boolean := True) return Boolean;
    --  Typ is a type entity. This function returns true if this type is partly
    --  initialized, meaning that an object of the type is at least partly
    --  initialized (in particular in the record case, that at least one
    --  component has an initialization expression). Note that initialization
    --  resulting from the use of pragma Normalized_Scalars does not count.
+   --  Include_Null controls the handling of access types, and components of
+   --  access types not explicitly initialized. If set to True, the default,
+   --  default initialization of access types counts as making the type be
+   --  partially initialized. If False, this does not count.
 
    function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean;
    --  Determines if type T is a potentially persistent type. A potentially

gcc/ada/sprint.adb

@@ -1995,6 +1995,7 @@ package body Sprint is
                Sprint_Node (Condition (Node));
             else
                Write_Str_With_Col_Check_Sloc ("for ");
+
                if Present (Iterator_Specification (Node)) then
                   Sprint_Node (Iterator_Specification (Node));
                else