[multiple changes]

2012-10-05  Thomas Quinot  <quinot@adacore.com>

	* sem_dim.adb, errout.adb, errout.ads (Analyze_Dimension_Call): Add
	guard against abnormal tree resulting from a previously diagnosed
	illegality.

2012-10-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb (Freeze_Expression): Rename local variable Cspc to Spec
	and update all refs to it. Do not freeze an entity outside a subprogram
	body when the original context is an expression function.

2012-10-05  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): Default for overflow checking
	is suppressed, even if backend overflow/divide checks are enabled.

2012-10-05  Ed Schonberg  <schonberg@adacore.com>

	* einfo.adb (Set_Invariant_Procedure, Set_Predicate_Function):
	chain properly subprograms on Subprograms_For_Type list.
	* sem_ch13.ads; (Build_Invariant_Procedure_Declaration): new
	procedure, to create declaration for invariant procedure
	independently of the construction of the body, so that it can
	be called within expression functions.
	* sem_ch13.adb (Build_Invariant_Procedure): code cleanup. The
	declaration may already have been generated at the point an
	explicit invariant aspect is encountered.
	* sem_prag.adb; (Analyze_Pragma, case Invariant): create declaration
	for invariant procedure.
	* sem_ch7.adb (Analyze_Package_Specification): clean up call to
	build invariant procedure.
	(Preserve_Full_Attributes): propagate information about invariants
	if they appear on a completion,

2012-10-05  Pascal Obry  <obry@adacore.com>

	* gnat_ugn.texi: Update documentation to lift Microsoft C
	restriction.

From-SVN: r192128

gcc/ada/ChangeLog

@@ -1,3 +1,43 @@
+2012-10-05  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_dim.adb, errout.adb, errout.ads (Analyze_Dimension_Call): Add
+	guard against abnormal tree resulting from a previously diagnosed
+	illegality.
+
+2012-10-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* freeze.adb (Freeze_Expression): Rename local variable Cspc to Spec
+	and update all refs to it. Do not freeze an entity outside a subprogram
+	body when the original context is an expression function.
+
+2012-10-05  Robert Dewar  <dewar@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): Default for overflow checking
+	is suppressed, even if backend overflow/divide checks are enabled.
+
+2012-10-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.adb (Set_Invariant_Procedure, Set_Predicate_Function):
+	chain properly subprograms on Subprograms_For_Type list.
+	* sem_ch13.ads; (Build_Invariant_Procedure_Declaration): new
+	procedure, to create declaration for invariant procedure
+	independently of the construction of the body, so that it can
+	be called within expression functions.
+	* sem_ch13.adb (Build_Invariant_Procedure): code cleanup. The
+	declaration may already have been generated at the point an
+	explicit invariant aspect is encountered.
+	* sem_prag.adb; (Analyze_Pragma, case Invariant): create declaration
+	for invariant procedure.
+	* sem_ch7.adb (Analyze_Package_Specification): clean up call to
+	build invariant procedure.
+	(Preserve_Full_Attributes): propagate information about invariants
+	if they appear on a completion,
+
+2012-10-05  Pascal Obry  <obry@adacore.com>
+
+	* gnat_ugn.texi: Update documentation to lift Microsoft C
+	restriction.
+
 2012-10-05  Robert Dewar  <dewar@adacore.com>
 
 	* sem_util.adb (Has_One_Matching_Field): Handle case of lone

gcc/ada/einfo.adb

@@ -7113,6 +7113,7 @@ package body Einfo is
 
       S := Subprograms_For_Type (Id);
       Set_Subprograms_For_Type (Id, V);
+      Set_Subprograms_For_Type (V, S);
 
       while Present (S) loop
          if Has_Invariants (S) then
@@ -7121,8 +7122,6 @@ package body Einfo is
             S := Subprograms_For_Type (S);
          end if;
       end loop;
-
-      Set_Subprograms_For_Type (Id, V);
    end Set_Invariant_Procedure;
 
    ----------------------------
@@ -7137,6 +7136,7 @@ package body Einfo is
 
       S := Subprograms_For_Type (Id);
       Set_Subprograms_For_Type (Id, V);
+      Set_Subprograms_For_Type (V, S);
 
       while Present (S) loop
          if Has_Predicates (S) then
@@ -7145,8 +7145,6 @@ package body Einfo is
             S := Subprograms_For_Type (S);
          end if;
       end loop;
-
-      Set_Subprograms_For_Type (Id, V);
    end Set_Predicate_Function;
 
    -----------------

gcc/ada/errout.adb

@@ -198,6 +198,21 @@ package body Errout is
    --  spec for precise definition of the conversion that is performed by this
    --  routine in OpenVMS mode.
 
+   --------------------
+   -- Cascaded_Error --
+   --------------------
+
+   procedure Cascaded_Error is
+   begin
+      --  An anomaly has been detected which is assumed to be a consequence of
+      --  a previous error. Raise an exception if no serious error has been
+      --  found so far.
+
+      if Serious_Errors_Detected = 0 then
+         raise Program_Error;
+      end if;
+   end Cascaded_Error;
+
    -----------------------
    -- Change_Error_Text --
    -----------------------

gcc/ada/errout.ads

@@ -727,6 +727,13 @@ package Errout is
    --  This routine can only be called during semantic analysis. It may not
    --  be called during parsing.
 
+   procedure Cascaded_Error;
+   --  When an anomaly is detected, many semantic routines silently bail out,
+   --  assuming that the anomaly was caused by a previously detected error.
+   --  This routine should be called in these cases, and will raise an
+   --  exception if no serious error has been detected. This ensure that the
+   --  anomaly is never allowed to go unnoticed.
+
    procedure Change_Error_Text (Error_Id : Error_Msg_Id; New_Msg : String);
    --  The error message text of the message identified by Id is replaced by
    --  the given text. This text may contain insertion characters in the

gcc/ada/freeze.adb

@@ -5156,44 +5156,64 @@ package body Freeze is
                --  subprogram body that we are inside.
 
                if In_Exp_Body (Parent_P) then
-
-                  --  However, we *do* want to freeze at this point if we have
-                  --  an entity to freeze, and that entity is declared *inside*
-                  --  the body of the expander generated procedure. This case
-                  --  is recognized by the scope of the type, which is either
-                  --  the spec for some enclosing body, or (in the case of
-                  --  init_procs, for which there are no separate specs) the
-                  --  current scope.
-
                   declare
                      Subp : constant Node_Id := Parent (Parent_P);
-                     Cspc : Entity_Id;
+                     Spec : Entity_Id;
 
                   begin
-                     if Nkind (Subp) = N_Subprogram_Body then
+                     --  Freeze the entity only when it is declared inside the
-                        Cspc := Corresponding_Spec (Subp);
+                     --  body of the expander generated procedure. This case
+                     --  is recognized by the scope of the entity or its type,
+                     --  which is either the spec for some enclosing body, or
+                     --  (in the case of init_procs, for which there are no
+                     --  separate specs) the current scope.
 
-                        if (Present (Typ) and then Scope (Typ) = Cspc)
+                     if Nkind (Subp) = N_Subprogram_Body then
+                        Spec := Corresponding_Spec (Subp);
+
+                        if (Present (Typ) and then Scope (Typ) = Spec)
                              or else
-                           (Present (Nam) and then Scope (Nam) = Cspc)
+                           (Present (Nam) and then Scope (Nam) = Spec)
                         then
                            exit;
 
                         elsif Present (Typ)
                           and then Scope (Typ) = Current_Scope
-                          and then Current_Scope = Defining_Entity (Subp)
+                          and then Defining_Entity (Subp) = Current_Scope
                         then
                            exit;
                         end if;
                      end if;
+
+                     --  An expression function may act as a completion of
+                     --  a function declaration. As such, it can reference
+                     --  entities declared between the two views:
+
+                     --     Hidden [];                             -- 1
+                     --     function F return ...;
+                     --     private
+                     --        function Hidden return ...;
+                     --        function F return ... is (Hidden);  -- 2
+
+                     --  Refering to the example above, freezing the expression
+                     --  of F (2) would place Hidden's freeze node (1) in the
+                     --  wrong place. Avoid explicit freezing and let the usual
+                     --  scenarios do the job - for example, reaching the end
+                     --  of the private declarations.
+
+                     if Nkind (Original_Node (Subp)) =
+                                                N_Expression_Function
+                     then
+                        null;
+
+                     --  Freeze outside the body
+
+                     else
+                        Parent_P := Parent (Parent_P);
+                        Freeze_Outside := True;
+                     end if;
                   end;
 
-                  --  If not that exception to the exception, then this is
-                  --  where we delay the freeze till outside the body.
-
-                  Parent_P := Parent (Parent_P);
-                  Freeze_Outside := True;
-
                --  Here if normal case where we are in handled statement
                --  sequence and want to do the insertion right there.
 

gcc/ada/gnat1drv.adb

@@ -328,12 +328,17 @@ procedure Gnat1drv is
          Exception_Mechanism := Back_End_Exceptions;
       end if;
 
-      --  Set proper status for overflow checks. If already set (by -gnato or
+      --  Set proper status for overflow checks
-      --  -gnatp) then we have nothing to do.
+
+      --  If already set (by - gnato or -gnatp) then we have nothing to do
 
       if Opt.Suppress_Options.Overflow_Checks_General /= Not_Set then
          null;
 
+      --  Otherwise set appropriate default mode. Note: at present we set
+      --  SUPPRESSED in all three of the following cases. They are separated
+      --  because in the future we may make different choices.
+
       --  By default suppress overflow checks in -gnatg mode
 
       elsif GNAT_Mode then
@@ -341,16 +346,18 @@ procedure Gnat1drv is
          Suppress_Options.Overflow_Checks_Assertions := Suppressed;
 
       --  If we have backend divide and overflow checks, then by default
-      --  overflow checks are minimized, which is a reasonable setting.
+      --  overflow checks are suppressed. Historically this code used to
+      --  activate overflow checks, although no target currently has these
+      --  flags set, so this was dead code anyway.
 
       elsif Targparm.Backend_Divide_Checks_On_Target
               and
             Targparm.Backend_Overflow_Checks_On_Target
       then
-         Suppress_Options.Overflow_Checks_General    := Minimized;
+         Suppress_Options.Overflow_Checks_General    := Suppressed;
-         Suppress_Options.Overflow_Checks_Assertions := Minimized;
+         Suppress_Options.Overflow_Checks_Assertions := Suppressed;
 
-      --  Otherwise for now, default is checks are suppressed. This is likely
+      --  Otherwise for now, default is checks are suppressed. This is subject
       --  to change in the future, but for now this is the compatible behavior
       --  with previous versions of GNAT.
 

gcc/ada/gnat_ugn.texi

@@ -28212,9 +28212,15 @@ success. It should be possible to use @code{GetLastError} and
 features are not used, but it is not guaranteed to work.
 
 @item
-It is not possible to link against Microsoft libraries except for
+It is not possible to link against Microsoft C++ libraries except for
 import libraries. Interfacing must be done by the mean of DLLs.
 
+@item
+It is possible to link against Microsoft C libraries. Yet the preferred
+solution is to use C/C++ compiler that comes with @value{EDITION}, since it
+doesn't require having two different development environments and makes the
+inter-language debugging experience smoother.
+
 @item
 When the compilation environment is located on FAT32 drives, users may
 experience recompilations of the source files that have not changed if
@@ -28302,14 +28308,14 @@ application that contains a mix of Ada and C/C++, the choice of your
 Windows C/C++ development environment conditions your overall
 interoperability strategy.
 
-If you use @command{gcc} to compile the non-Ada part of your application,
+If you use @command{gcc} or Microsoft C to compile the non-Ada part of
-there are no Windows-specific restrictions that affect the overall
+your application, there are no Windows-specific restrictions that
-interoperability with your Ada code. If you do want to use the
+affect the overall interoperability with your Ada code. If you do want
-Microsoft tools for your non-Ada code, you have two choices:
+to use the Microsoft tools for your C++ code, you have two choices:
 
 @enumerate
 @item
-Encapsulate your non-Ada code in a DLL to be linked with your Ada
+Encapsulate your C++ code in a DLL to be linked with your Ada
 application. In this case, use the Microsoft or whatever environment to
 build the DLL and use GNAT to build your executable
 (@pxref{Using DLLs with GNAT}).

gcc/ada/sem_ch13.adb

@@ -4902,6 +4902,48 @@ package body Sem_Ch13 is
       end if;
    end Analyze_Record_Representation_Clause;
 
+   -------------------------------------------
+   -- Build_Invariant_Procedure_Declaration --
+   -------------------------------------------
+
+   function Build_Invariant_Procedure_Declaration
+     (Typ : Entity_Id) return Node_Id
+   is
+      Loc           : constant Source_Ptr := Sloc (Typ);
+      Object_Entity : constant Entity_Id :=
+        Make_Defining_Identifier (Loc, New_Internal_Name ('I'));
+      Spec          : Node_Id;
+      SId           : Entity_Id;
+
+   begin
+      Set_Etype (Object_Entity, Typ);
+
+      --  Check for duplicate definiations.
+
+      if Has_Invariants (Typ)
+        and then Present (Invariant_Procedure (Typ))
+      then
+         return Empty;
+      end if;
+
+      SId := Make_Defining_Identifier (Loc,
+         Chars => New_External_Name (Chars (Typ), "Invariant"));
+      Set_Has_Invariants (SId);
+      Set_Has_Invariants (Typ);
+      Set_Ekind (SId, E_Procedure);
+      Set_Invariant_Procedure (Typ, SId);
+
+      Spec :=
+        Make_Procedure_Specification (Loc,
+          Defining_Unit_Name       => SId,
+          Parameter_Specifications => New_List (
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier => Object_Entity,
+              Parameter_Type      => New_Occurrence_Of (Typ, Loc))));
+
+      return Make_Subprogram_Declaration (Loc, Specification => Spec);
+   end Build_Invariant_Procedure_Declaration;
+
    -------------------------------
    -- Build_Invariant_Procedure --
    -------------------------------
@@ -4936,12 +4978,11 @@ package body Sem_Ch13 is
       --  "inherited" to the exception message and generating an informational
       --  message about the inheritance of an invariant.
 
-      Object_Name : constant Name_Id := New_Internal_Name ('I');
+      Object_Name : Name_Id;
       --  Name for argument of invariant procedure
 
-      Object_Entity : constant Node_Id :=
+      Object_Entity : Node_Id;
-                        Make_Defining_Identifier (Loc, Object_Name);
+      --  The entity of the formal for the procedure
-      --  The procedure declaration entity for the argument
 
       --------------------
       -- Add_Invariants --
@@ -5140,7 +5181,29 @@ package body Sem_Ch13 is
       Stmts := No_List;
       PDecl := Empty;
       PBody := Empty;
-      Set_Etype (Object_Entity, Typ);
+      SId   := Empty;
+
+      --  If the aspect specification exists for some view of the type, the
+      --  declaration for the procedure has been created.
+
+      if Has_Invariants (Typ) then
+         SId := Invariant_Procedure (Typ);
+      end if;
+
+      if Present (SId) then
+         PDecl := Unit_Declaration_Node (SId);
+
+      else
+         PDecl := Build_Invariant_Procedure_Declaration (Typ);
+      end if;
+
+      --  Recover formal of procedure, for use in the calls to invariant
+      --  functions (including inherited ones).
+
+      Object_Entity :=
+        Defining_Identifier
+          (First (Parameter_Specifications (Specification (PDecl))));
+      Object_Name := Chars (Object_Entity);
 
       --  Add invariants for the current type
 
@@ -5174,38 +5237,7 @@ package body Sem_Ch13 is
 
       if Stmts /= No_List then
 
-         --  Build procedure declaration
+         Spec  := Copy_Separate_Tree (Specification (PDecl));
-
-         SId :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Typ), "Invariant"));
-         Set_Has_Invariants (SId);
-         Set_Invariant_Procedure (Typ, SId);
-
-         Spec :=
-           Make_Procedure_Specification (Loc,
-             Defining_Unit_Name       => SId,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier => Object_Entity,
-                 Parameter_Type      => New_Occurrence_Of (Typ, Loc))));
-
-         PDecl := Make_Subprogram_Declaration (Loc, Specification => Spec);
-
-         --  Build procedure body
-
-         SId :=
-           Make_Defining_Identifier (Loc,
-             Chars => New_External_Name (Chars (Typ), "Invariant"));
-
-         Spec :=
-           Make_Procedure_Specification (Loc,
-             Defining_Unit_Name       => SId,
-             Parameter_Specifications => New_List (
-               Make_Parameter_Specification (Loc,
-                 Defining_Identifier =>
-                   Make_Defining_Identifier (Loc, Object_Name),
-                 Parameter_Type => New_Occurrence_Of (Typ, Loc))));
 
          PBody :=
            Make_Subprogram_Body (Loc,
@@ -5216,14 +5248,18 @@ package body Sem_Ch13 is
                  Statements => Stmts));
 
          --  Insert procedure declaration and spec at the appropriate points.
+         --  If declaration is already analyzed, it was processed by the
+         --  generated pragma.
 
          if Present (Private_Decls) then
 
             --  The spec goes at the end of visible declarations, but they have
             --  already been analyzed, so we need to explicitly do the analyze.
 
-            Append_To (Visible_Decls, PDecl);
+            if not Analyzed (PDecl) then
-            Analyze (PDecl);
+               Append_To (Visible_Decls, PDecl);
+               Analyze (PDecl);
+            end if;
 
             --  The body goes at the end of the private declarations, which we
             --  have not analyzed yet, so we do not need to perform an explicit
@@ -5523,6 +5559,7 @@ package body Sem_Ch13 is
            Make_Defining_Identifier (Loc,
              Chars => New_External_Name (Chars (Typ), "Predicate"));
          Set_Has_Predicates (SId);
+         Set_Ekind (SId, E_Function);
          Set_Predicate_Function (Typ, SId);
 
          --  The predicate function is shared between views of a type.

gcc/ada/sem_ch13.ads

@@ -46,6 +46,14 @@ package Sem_Ch13 is
    --  order is specified and there is at least one component clause. Adjusts
    --  component positions according to either Ada 95 or Ada 2005 (AI-133).
 
+   function Build_Invariant_Procedure_Declaration
+     (Typ : Entity_Id) return Node_Id;
+   --  If a type declaration has a specified invariant aspect, build the
+   --  declaration for the procedure at once, so that calls to it can be
+   --  generated before the body of the invariant procedure is built. This
+   --  is needed in the presence of public expression functions that return
+   --  the type in question.
+
    procedure Build_Invariant_Procedure (Typ : Entity_Id; N : Node_Id);
    --  Typ is a private type with invariants (indicated by Has_Invariants being
    --  set for Typ, indicating the presence of pragma Invariant entries on the

gcc/ada/sem_ch7.adb

@@ -28,6 +28,7 @@
 --  handling of private and full declarations, and the construction of dispatch
 --  tables for tagged types.
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -1387,7 +1388,21 @@ package body Sem_Ch7 is
            and then Nkind (Parent (E)) = N_Full_Type_Declaration
            and then Has_Aspects (Parent (E))
          then
-            Build_Invariant_Procedure (E, N);
+            declare
+               ASN : Node_Id;
+            begin
+               ASN := First (Aspect_Specifications (Parent (E)));
+               while Present (ASN) loop
+                  if Chars (Identifier (ASN)) = Name_Invariant
+                    or else Chars (Identifier (ASN)) = Name_Type_Invariant
+                  then
+                     Build_Invariant_Procedure (E, N);
+                     exit;
+                  end if;
+
+                  Next (ASN);
+               end loop;
+            end;
          end if;
 
          Next_Entity (E);
@@ -2143,6 +2158,14 @@ package body Sem_Ch7 is
 
          Set_Freeze_Node (Priv, Freeze_Node (Full));
 
+         --  Propagate information of type invariants, which may be specified
+         --  for the full view.
+
+         if Has_Invariants (Full) and not Has_Invariants (Priv) then
+            Set_Has_Invariants (Priv);
+            Set_Subprograms_For_Type (Priv, Subprograms_For_Type (Full));
+         end if;
+
          if Is_Tagged_Type (Priv)
            and then Is_Tagged_Type (Full)
            and then not Error_Posted (Full)

gcc/ada/sem_dim.adb

@@ -1629,6 +1629,15 @@ package body Sem_Dim is
          Formal := First_Formal (Nam);
 
          while Present (Formal) loop
+
+            --  A missing corresponding actual indicates that the analysis of
+            --  the call was aborted due to a previous error.
+
+            if No (Actual) then
+               Cascaded_Error;
+               return;
+            end if;
+
             Formal_Typ     := Etype (Formal);
             Dims_Of_Formal := Dimensions_Of (Formal_Typ);
 

gcc/ada/sem_prag.adb

@@ -10329,6 +10329,7 @@ package body Sem_Prag is
          when Pragma_Invariant => Invariant : declare
             Type_Id : Node_Id;
             Typ     : Entity_Id;
+            PDecl   : Node_Id;
 
             Discard : Boolean;
             pragma Unreferenced (Discard);
@@ -10380,8 +10381,13 @@ package body Sem_Prag is
 
             --  Note that the type has at least one invariant, and also that
             --  it has inheritable invariants if we have Invariant'Class.
+            --  Build the corresponding invariant procedure declaration, so
+            --  that calls to it can be generated before the body is built
+            --  (for example wihin an expression function).
 
-            Set_Has_Invariants (Typ);
+            PDecl := Build_Invariant_Procedure_Declaration (Typ);
+            Insert_After (N, PDecl);
+            Analyze (PDecl);
 
             if Class_Present (N) then
                Set_Has_Inheritable_Invariants (Typ);