[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

12 files changed, 252 insertions, 76 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a17998a..ea4667f 100644
--- a/gcc/ada/ChangeLog
+++ b/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
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index e7c9146..bfa7593 100644
--- a/gcc/ada/einfo.adb
+++ b/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;
 
    -----------------
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 6f45020..64062b2 100644
--- a/gcc/ada/errout.adb
+++ b/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 --
    -----------------------
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 212eea4..7da6493 100644
--- a/gcc/ada/errout.ads
+++ b/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
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 039325a..9e0cbca 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -5156,43 +5156,63 @@ 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
+                     --  Freeze the entity only when it is declared inside the
+                     --  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 Nkind (Subp) = N_Subprogram_Body then
-                        Cspc := Corresponding_Spec (Subp);
+                        Spec := Corresponding_Spec (Subp);
 
-                        if (Present (Typ) and then Scope (Typ) = Cspc)
+                        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;
-                  end;
 
-                  --  If not that exception to the exception, then this is
-                  --  where we delay the freeze till outside the body.
+                     --  An expression function may act as a completion of
+                     --  a function declaration. As such, it can reference
+                     --  entities declared between the two views:
 
-                  Parent_P := Parent (Parent_P);
-                  Freeze_Outside := True;
+                     --     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;
 
                --  Here if normal case where we are in handled statement
                --  sequence and want to do the insertion right there.
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 2d79edf..a4d01c9 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/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
-      --  -gnatp) then we have nothing to do.
+      --  Set proper status for overflow checks
+
+      --  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_Assertions := Minimized;
+         Suppress_Options.Overflow_Checks_General    := Suppressed;
+         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.
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 45c02d8..b94f035 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -28212,10 +28212,16 @@ 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
 Daylight Saving Time (DST) state has changed since the last time files
@@ -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,
-there are no Windows-specific restrictions that affect the overall
-interoperability with your Ada code. If you do want to use the
-Microsoft tools for your non-Ada code, you have two choices:
+If you use @command{gcc} or Microsoft C to compile the non-Ada part of
+your application, there are no Windows-specific restrictions that
+affect the overall interoperability with your Ada code. If you do want
+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}).
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d75b70b..521eb80 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/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 :=
-                        Make_Defining_Identifier (Loc, Object_Name);
-      --  The procedure declaration entity for the argument
+      Object_Entity : Node_Id;
+      --  The entity of the formal for the procedure
 
       --------------------
       -- 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
-
-         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))));
+         Spec  := Copy_Separate_Tree (Specification (PDecl));
 
          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);
-            Analyze (PDecl);
+            if not Analyzed (PDecl) then
+               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.
diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads
index 0ac7386..611f3f1c 100644
--- a/gcc/ada/sem_ch13.ads
+++ b/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
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 326219d..103aa5b 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/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)
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index afe7d85..9b9de0a 100644
--- a/gcc/ada/sem_dim.adb
+++ b/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);
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c791c33..1739673 100644
--- a/gcc/ada/sem_prag.adb
+++ b/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);