015-02-05 Robert Dewar <dewar@adacore.com>

	* sem_ch13.adb (Add_Invariants): Don't assume invariant is
	standard Boolean.
	* sem_prag.adb (Analyze_Pragma, case Check): Don't assume
	condition is standard Boolean, it can be non-standard derived
	Boolean.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Enable_Range_Check): Disconnect attempted
	optimization for the case of range check for subscript of
	unconstrained array.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* par-ch13.adb (With_Present): New function
	(Aspect_Specifications_Present): Handle WHEN in place of WITH
	(Get_Aspect_Specifications): Comment update.
	* par.adb: Comment updates.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* errout.adb (Handle_Serious_Error): New setting of Fatal_Error.
	* frontend.adb (Frontend): New setting of Fatal_Error.
	* lib-load.adb (Create_Dummy_Package_Unit): New setting of
	Fatal_Error.
	(Load_Main_Source): New setting of Fatal_Error
	(Load_Unit): New setting of Fatal_Error.
	* lib-writ.adb (Add_Preprocessing_Dependency): New setting of
	Fatal_Error.
	(Ensure_System_Dependency): New setting of Fatal_Error.
	* lib.adb (Fatal_Error): New setting of Fatal_Error
	(Set_Fatal_Error): New setting of Fatal_Error.
	* lib.ads: New definition of Fatal_Error and associated routines.
	* par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error.
	* par-load.adb (Load): New setting of Fatal_Error.
	* rtsfind.adb (Load_RTU): New setting of Fatal_Error.
	* sem_ch10.adb (Analyze_Compilation_Unit): New setting of
	Fatal_Error.
	(Optional_Subunit): New setting of Fatal_Error.
	(Analyze_Proper_Body): New setting of Fatal_Error.
	(Load_Needed_Body): New setting of Fatal_Error.

2015-02-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Call): If the function being called has
	out parameters do not check for language version if the function
	comes from a predefined unit, as those are always compiled in
	Ada 2012 mode.

2015-02-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Process_Full_View): Verify that the full view
	of a type extension must carry an explicit limited keyword if
	the partial view does (RM 7.3 (10.1)).

From-SVN: r220446

18 files changed, 245 insertions, 81 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index acadafe..bd6f02a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,62 @@
 2015-02-05  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch13.adb (Add_Invariants): Don't assume invariant is
+	standard Boolean.
+	* sem_prag.adb (Analyze_Pragma, case Check): Don't assume
+	condition is standard Boolean, it can be non-standard derived
+	Boolean.
+
+2015-02-05  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Enable_Range_Check): Disconnect attempted
+	optimization for the case of range check for subscript of
+	unconstrained array.
+
+2015-02-05  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch13.adb (With_Present): New function
+	(Aspect_Specifications_Present): Handle WHEN in place of WITH
+	(Get_Aspect_Specifications): Comment update.
+	* par.adb: Comment updates.
+
+2015-02-05  Robert Dewar  <dewar@adacore.com>
+
+	* errout.adb (Handle_Serious_Error): New setting of Fatal_Error.
+	* frontend.adb (Frontend): New setting of Fatal_Error.
+	* lib-load.adb (Create_Dummy_Package_Unit): New setting of
+	Fatal_Error.
+	(Load_Main_Source): New setting of Fatal_Error
+	(Load_Unit): New setting of Fatal_Error.
+	* lib-writ.adb (Add_Preprocessing_Dependency): New setting of
+	Fatal_Error.
+	(Ensure_System_Dependency): New setting of Fatal_Error.
+	* lib.adb (Fatal_Error): New setting of Fatal_Error
+	(Set_Fatal_Error): New setting of Fatal_Error.
+	* lib.ads: New definition of Fatal_Error and associated routines.
+	* par-ch10.adb (P_Compilation_Unit): New setting of Fatal_Error.
+	* par-load.adb (Load): New setting of Fatal_Error.
+	* rtsfind.adb (Load_RTU): New setting of Fatal_Error.
+	* sem_ch10.adb (Analyze_Compilation_Unit): New setting of
+	Fatal_Error.
+	(Optional_Subunit): New setting of Fatal_Error.
+	(Analyze_Proper_Body): New setting of Fatal_Error.
+	(Load_Needed_Body): New setting of Fatal_Error.
+
+2015-02-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Call): If the function being called has
+	out parameters do not check for language version if the function
+	comes from a predefined unit, as those are always compiled in
+	Ada 2012 mode.
+
+2015-02-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Process_Full_View): Verify that the full view
+	of a type extension must carry an explicit limited keyword if
+	the partial view does (RM 7.3 (10.1)).
+
+2015-02-05  Robert Dewar  <dewar@adacore.com>
+
 	* g-rannum.adb, g-rannum.ads, s-rannum.adb, s-rannum.ads,
 	sem_warn.ads: Minor reformatting.
 	* exp_ch13.adb (Expand_N_Freeze_Entity): Add guard for aspect
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index e822db3..87c3995 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -5521,10 +5521,14 @@ package body Checks is
                   return;
                end if;
 
-            --  Ditto if the prefix is an explicit dereference whose designated
-            --  type is unconstrained.
+            --  Ditto if prefix is simply an unconstrained array. We used
+            --  to think this case was OK, if the prefix was not an explicit
+            --  dereference, but we have now seen a case where this is not
+            --  true, so it is safer to just suppress the optimization in this
+            --  case. The back end is getting better at eliminating redundant
+            --  checks in any case, so the loss won't be important.
 
-            elsif Nkind (Prefix (P)) = N_Explicit_Dereference
+            elsif Is_Array_Type (Atyp)
               and then not Is_Constrained (Atyp)
             then
                Activate_Range_Check (N);
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index e48956b..df0fa96 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -753,12 +753,23 @@ package body Errout is
          end if;
 
          --  Set the fatal error flag in the unit table unless we are in
-         --  Try_Semantics mode. This stops the semantics from being performed
+         --  Try_Semantics mode (in which case we set ignored mode if not
+         --  currently set. This stops the semantics from being performed
          --  if we find a serious error. This is skipped if we are currently
          --  dealing with the configuration pragma file.
 
-         if not Try_Semantics and then Current_Source_Unit /= No_Unit then
-            Set_Fatal_Error (Get_Source_Unit (Sptr));
+         if Current_Source_Unit /= No_Unit then
+            declare
+               U : constant Unit_Number_Type := Get_Source_Unit (Sptr);
+            begin
+               if Try_Semantics then
+                  if Fatal_Error (U) = None then
+                     Set_Fatal_Error (U, Error_Ignored);
+                  end if;
+               else
+                  Set_Fatal_Error (U, Error_Detected);
+               end if;
+            end;
          end if;
       end Handle_Serious_Error;
 
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 51ea9e8..adee97d 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -338,7 +338,7 @@ begin
      --  unit failed to load, to avoid cascaded inconsistencies that can lead
      --  to a compiler crash.
 
-     and then not Fatal_Error (Main_Unit)
+     and then Fatal_Error (Main_Unit) /= Error_Detected
    then
       --  Pragmas that require some semantic activity, such as Interrupt_State,
       --  cannot be processed until the main unit is installed, because they
@@ -388,7 +388,7 @@ begin
 
       --  Following steps are skipped if we had a fatal error during parsing
 
-      if not Fatal_Error (Main_Unit) then
+      if Fatal_Error (Main_Unit) /= Error_Detected then
 
          --  Reset Operating_Mode to Check_Semantics for subunits. We cannot
          --  actually generate code for subunits, so we suppress expansion.
diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 34b20cc..fc52f84 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -212,7 +212,7 @@ package body Lib.Load is
         Dynamic_Elab      => False,
         Error_Location    => Sloc (With_Node),
         Expected_Unit     => Spec_Name,
-        Fatal_Error       => True,
+        Fatal_Error       => Error_Detected,
         Generate_Code     => False,
         Has_RACW          => False,
         Filler            => False,
@@ -319,7 +319,7 @@ package body Lib.Load is
            Dynamic_Elab      => False,
            Error_Location    => No_Location,
            Expected_Unit     => No_Unit_Name,
-           Fatal_Error       => False,
+           Fatal_Error       => None,
            Generate_Code     => False,
            Has_RACW          => False,
            Filler            => False,
@@ -683,7 +683,7 @@ package body Lib.Load is
               Dynamic_Elab      => False,
               Error_Location    => Sloc (Error_Node),
               Expected_Unit     => Uname_Actual,
-              Fatal_Error       => False,
+              Fatal_Error       => None,
               Generate_Code     => False,
               Has_RACW          => False,
               Filler            => False,
@@ -742,10 +742,20 @@ package body Lib.Load is
 
             --  If loaded unit had a fatal error, then caller inherits it
 
-            if Units.Table (Unum).Fatal_Error
-              and then Present (Error_Node)
-            then
-               Units.Table (Calling_Unit).Fatal_Error := True;
+            if Present (Error_Node) then
+               case Units.Table (Unum).Fatal_Error is
+                  when None =>
+                     null;
+
+                  when Error_Detected =>
+                     Units.Table (Calling_Unit).Fatal_Error := Error_Detected;
+
+                  when Error_Ignored =>
+                     if Units.Table (Calling_Unit).Fatal_Error = None then
+                        Units.Table (Calling_Unit).Fatal_Error :=
+                                                               Error_Ignored;
+                     end if;
+               end case;
             end if;
 
             --  Remove load stack entry and return the entry in the file table
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index b466734..5a3dcc4 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -81,7 +81,7 @@ package body Lib.Writ is
          Cunit_Entity      => Empty,
          Dependency_Num    => 0,
          Dynamic_Elab      => False,
-         Fatal_Error       => False,
+         Fatal_Error       => None,
          Generate_Code     => False,
          Has_RACW          => False,
          Filler            => False,
@@ -139,7 +139,7 @@ package body Lib.Writ is
         Cunit_Entity      => Empty,
         Dependency_Num    => 0,
         Dynamic_Elab      => False,
-        Fatal_Error       => False,
+        Fatal_Error       => None,
         Generate_Code     => False,
         Has_RACW          => False,
         Filler            => False,
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index 609a03c..08866b2 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -106,7 +106,7 @@ package body Lib is
       return Units.Table (U).Expected_Unit;
    end Expected_Unit;
 
-   function Fatal_Error (U : Unit_Number_Type) return Boolean is
+   function Fatal_Error (U : Unit_Number_Type) return Fatal_Type is
    begin
       return Units.Table (U).Fatal_Error;
    end Fatal_Error;
@@ -196,9 +196,9 @@ package body Lib is
       Units.Table (U).Error_Location := W;
    end Set_Error_Location;
 
-   procedure Set_Fatal_Error (U : Unit_Number_Type; B : Boolean := True) is
+   procedure Set_Fatal_Error (U : Unit_Number_Type; V : Fatal_Type) is
    begin
-      Units.Table (U).Fatal_Error := B;
+      Units.Table (U).Fatal_Error := V;
    end Set_Fatal_Error;
 
    procedure Set_Generate_Code (U : Unit_Number_Type; B : Boolean := True) is
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index 8cac209..4e9471c 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -302,7 +302,7 @@ package Lib is
    --      No_Name for the main unit.
 
    --    Fatal_Error
-   --      A flag that is initialized to False, and gets set to True if a fatal
+   --      A flag that is initialized to None and gets set to Errorif a fatal
    --      error occurs during the processing of a unit. A fatal error is one
    --      defined as serious enough to stop the next phase of the compiler
    --      from running (i.e. fatal error during parsing stops semantics,
@@ -310,6 +310,7 @@ package Lib is
    --      currently, errors of any kind cause Fatal_Error to be set, but
    --      eventually perhaps only errors labeled as fatal errors should be
    --      this severe if we decide to try Sem on sources with minor errors.
+   --      There are three settings (see declaration of Fatal_Type).
 
    --    Generate_Code
    --      This flag is set True for all units in the current file for which
@@ -401,13 +402,29 @@ package Lib is
    Default_Main_CPU : constant Int := -1;
    --  Value used in Main_CPU field to indicate default main affinity
 
+   --  The following defines settings for the Fatal_Error field
+
+   type Fatal_Type is (
+      None,
+      --  No error detected for this unit
+
+      Error_Detected,
+      --  Fatal error detected that prevents moving to the next phase. For
+      --  example, a fatal error during parsing inhibits semantic analysis.
+
+      Error_Ignored);
+      --  A fatal error was detected, but we are in Try_Semantics mode (as set
+      --  by -gnatq or -gnatQ). This does not stop the compiler from proceding,
+      --  but tools can use this status (e.g. ASIS looking at the generated
+      --  tree) to know that a fatal error was detected.
+
    function Cunit             (U : Unit_Number_Type) return Node_Id;
    function Cunit_Entity      (U : Unit_Number_Type) return Entity_Id;
    function Dependency_Num    (U : Unit_Number_Type) return Nat;
    function Dynamic_Elab      (U : Unit_Number_Type) return Boolean;
    function Error_Location    (U : Unit_Number_Type) return Source_Ptr;
    function Expected_Unit     (U : Unit_Number_Type) return Unit_Name_Type;
-   function Fatal_Error       (U : Unit_Number_Type) return Boolean;
+   function Fatal_Error       (U : Unit_Number_Type) return Fatal_Type;
    function Generate_Code     (U : Unit_Number_Type) return Boolean;
    function Ident_String      (U : Unit_Number_Type) return Node_Id;
    function Has_RACW          (U : Unit_Number_Type) return Boolean;
@@ -422,20 +439,20 @@ package Lib is
    function Unit_Name         (U : Unit_Number_Type) return Unit_Name_Type;
    --  Get value of named field from given units table entry
 
-   procedure Set_Cunit             (U : Unit_Number_Type; N : Node_Id);
-   procedure Set_Cunit_Entity      (U : Unit_Number_Type; E : Entity_Id);
-   procedure Set_Dynamic_Elab      (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Error_Location    (U : Unit_Number_Type; W : Source_Ptr);
-   procedure Set_Fatal_Error       (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Generate_Code     (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Has_RACW          (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Ident_String      (U : Unit_Number_Type; N : Node_Id);
-   procedure Set_Loading           (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Main_CPU          (U : Unit_Number_Type; P : Int);
-   procedure Set_No_Elab_Code_All  (U : Unit_Number_Type; B : Boolean := True);
-   procedure Set_Main_Priority     (U : Unit_Number_Type; P : Int);
-   procedure Set_OA_Setting        (U : Unit_Number_Type; C : Character);
-   procedure Set_Unit_Name         (U : Unit_Number_Type; N : Unit_Name_Type);
+   procedure Set_Cunit            (U : Unit_Number_Type; N : Node_Id);
+   procedure Set_Cunit_Entity     (U : Unit_Number_Type; E : Entity_Id);
+   procedure Set_Dynamic_Elab     (U : Unit_Number_Type; B : Boolean := True);
+   procedure Set_Error_Location   (U : Unit_Number_Type; W : Source_Ptr);
+   procedure Set_Fatal_Error      (U : Unit_Number_Type; V : Fatal_Type);
+   procedure Set_Generate_Code    (U : Unit_Number_Type; B : Boolean := True);
+   procedure Set_Has_RACW         (U : Unit_Number_Type; B : Boolean := True);
+   procedure Set_Ident_String     (U : Unit_Number_Type; N : Node_Id);
+   procedure Set_Loading          (U : Unit_Number_Type; B : Boolean := True);
+   procedure Set_Main_CPU         (U : Unit_Number_Type; P : Int);
+   procedure Set_No_Elab_Code_All (U : Unit_Number_Type; B : Boolean := True);
+   procedure Set_Main_Priority    (U : Unit_Number_Type; P : Int);
+   procedure Set_OA_Setting       (U : Unit_Number_Type; C : Character);
+   procedure Set_Unit_Name        (U : Unit_Number_Type; N : Unit_Name_Type);
    --  Set value of named field for given units table entry. Note that we
    --  do not have an entry for each possible field, since some of the fields
    --  can only be set by specialized interfaces (defined below).
@@ -606,7 +623,7 @@ package Lib is
    function Is_Loaded (Uname : Unit_Name_Type) return Boolean;
    --  Determines if unit with given name is already loaded, i.e. there is
    --  already an entry in the file table with this unit name for which the
-   --  corresponding file was found and parsed. Note that the Fatal_Error flag
+   --  corresponding file was found and parsed. Note that the Fatal_Error value
    --  of this entry must be checked before proceeding with further processing.
 
    function Last_Unit return Unit_Number_Type;
@@ -767,7 +784,7 @@ private
       Serial_Number     : Nat;
       Version           : Word;
       Error_Location    : Source_Ptr;
-      Fatal_Error       : Boolean;
+      Fatal_Error       : Fatal_Type;
       Generate_Code     : Boolean;
       Has_RACW          : Boolean;
       Dynamic_Elab      : Boolean;
diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb
index 2cb4241..5511730 100644
--- a/gcc/ada/par-ch10.adb
+++ b/gcc/ada/par-ch10.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -596,7 +596,7 @@ package body Ch10 is
 
       else
          Cunit_Error_Flag := True;
-         Set_Fatal_Error (Current_Source_Unit);
+         Set_Fatal_Error (Current_Source_Unit, Error_Detected);
       end if;
 
       --  Clear away any missing semicolon indication, we are done with that
@@ -726,7 +726,7 @@ package body Ch10 is
          --  cascaded messages in some situations.
 
          else
-            if not Fatal_Error (Current_Source_Unit) then
+            if Fatal_Error (Current_Source_Unit) /= Error_Detected then
                if Token in Token_Class_Cunit then
                   Error_Msg_SC
                     ("end of file expected, " &
@@ -758,7 +758,7 @@ package body Ch10 is
       --  An error resync is a serious bomb, so indicate result unit no good
 
       when Error_Resync =>
-         Set_Fatal_Error (Current_Source_Unit);
+         Set_Fatal_Error (Current_Source_Unit, Error_Detected);
          return Error;
    end P_Compilation_Unit;
 
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 5d4f7d2..fc8874b 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -48,6 +48,10 @@ package body Ch13 is
       function Possible_Misspelled_Aspect return Boolean;
       --  Returns True, if Token_Name is a misspelling of some aspect name
 
+      function With_Present return Boolean;
+      --  Returns True if WITH is present, indicating presence of aspect
+      --  specifications. Also allows incorrect use of WHEN in place of WITH.
+
       --------------------------------
       -- Possible_Misspelled_Aspect --
       --------------------------------
@@ -63,6 +67,43 @@ package body Ch13 is
          return False;
       end Possible_Misspelled_Aspect;
 
+      ------------------
+      -- With_Present --
+      ------------------
+
+      function With_Present return Boolean is
+      begin
+         if Token = Tok_With then
+            return True;
+
+         --  Check for WHEN used in place of WITH
+
+         elsif Token = Tok_When then
+            declare
+               Scan_State : Saved_Scan_State;
+
+            begin
+               Save_Scan_State (Scan_State);
+               Scan; -- past WHEN
+
+               if Token = Tok_Identifier
+                 and then Get_Aspect_Id (Token_Name) /= No_Aspect
+               then
+                  Error_Msg_SC ("WHEN should be WITH");
+                  Restore_Scan_State (Scan_State);
+                  return True;
+
+               else
+                  Restore_Scan_State (Scan_State);
+                  return False;
+               end if;
+            end;
+
+         else
+            return False;
+         end if;
+      end With_Present;
+
    --  Start of processing for Aspect_Specifications_Present
 
    begin
@@ -79,14 +120,15 @@ package body Ch13 is
       --  be too expensive. Instead we pick up the aspect specifications later
       --  as a bogus declaration, and diagnose the semicolon at that point.
 
-      if Token /= Tok_With then
+      if not With_Present then
          return False;
       end if;
 
-      --  Have a WITH, see if it looks like an aspect specification
+      --  Have a WITH or some token that we accept as a legitimate bad attempt
+      --  at writing WITH. See if it looks like an aspect specification
 
       Save_Scan_State (Scan_State);
-      Scan; -- past WITH
+      Scan; -- past WITH (or WHEN or other bad keyword)
 
       --  If no identifier, then consider that we definitely do not have an
       --  aspect specification.
@@ -193,7 +235,7 @@ package body Ch13 is
          return Aspects;
       end if;
 
-      Scan; -- past WITH
+      Scan; -- past WITH (or possible WHEN after error)
       Aspects := Empty_List;
 
       --  Loop to scan aspects
diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb
index 7415253..ebd5709 100644
--- a/gcc/ada/par-load.adb
+++ b/gcc/ada/par-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -127,7 +127,7 @@ procedure Load is
 begin
    --  Don't do any loads if we already had a fatal error
 
-   if Fatal_Error (Cur_Unum) then
+   if Fatal_Error (Cur_Unum) = Error_Detected then
       return;
    end if;
 
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 83f320b..76f6e53 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -951,6 +951,9 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  permitted). Note: this routine never checks the terminator token
       --  for aspects so it does not matter whether the aspect specifications
       --  are terminated by semicolon or some other character.
+      --
+      --  Note: This function also handles the case of WHEN used where WITH
+      --  was intended, and in that case posts an error and returns True.
 
       procedure P_Aspect_Specifications
         (Decl      : Node_Id;
@@ -960,15 +963,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  argument is False, the scan pointer is left pointing past the aspects
       --  and the caller must check for a proper terminator.
       --
-      --  P_Aspect_Specifications is called with the current token pointing to
-      --  either a WITH keyword starting an aspect specification, or an
-      --  instance of the terminator token. In the former case, the aspect
-      --  specifications are scanned out including the terminator token if it
-      --  it is a semicolon, and the Has_Aspect_Specifications flag is set in
-      --  the given declaration node. A list of aspects is built and stored for
-      --  this declaration node using a call to Set_Aspect_Specifications. If
-      --  no WITH keyword is present, then this call has no effect other than
-      --  scanning out the terminator if it is a semicolon.
+      --  P_Aspect_Specifications is called with the current token pointing
+      --  to either a WITH keyword starting an aspect specification, or an
+      --  instance of what shpould be a terminator token. In the former case,
+      --  the aspect specifications are scanned out including the terminator
+      --  token if it it is a semicolon, and the Has_Aspect_Specifications
+      --  flag is set in the given declaration node. A list of aspects
+      --  is built and stored for this declaration node using a call to
+      --  Set_Aspect_Specifications. If no WITH keyword is present, then this
+      --  call has no effect other than scanning out the terminator if it is a
+      --  semicolon (with the exception that it detects WHEN used in place of
+      --  WITH).
 
       --  If Decl is Error on entry, any scanned aspect specifications are
       --  ignored and a message is output saying aspect specifications not
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 29ca1fa..c96e708 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -979,7 +979,7 @@ package body Rtsfind is
 
       if U.Unum = No_Unit then
          Load_Fail ("not found", U_Id, Id);
-      elsif Fatal_Error (U.Unum) then
+      elsif Fatal_Error (U.Unum) = Error_Detected then
          Load_Fail ("had parser errors", U_Id, Id);
       end if;
 
@@ -1025,7 +1025,7 @@ package body Rtsfind is
                Semantics (Cunit (U.Unum));
                Restore_Private_Visibility;
 
-               if Fatal_Error (U.Unum) then
+               if Fatal_Error (U.Unum) = Error_Detected then
                   Load_Fail ("had semantic errors", U_Id, Id);
                end if;
             end if;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 5e66316..d7df7eb 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -936,7 +936,7 @@ package body Sem_Ch10 is
         and then (Distribution_Stub_Mode = Generate_Receiver_Stub_Body
                     or else
                   Distribution_Stub_Mode = Generate_Caller_Stub_Body)
-        and then not Fatal_Error (Main_Unit)
+        and then Fatal_Error (Main_Unit) /= Error_Detected
       then
          if Is_RCI_Pkg_Spec_Or_Body (N) then
 
@@ -1096,7 +1096,7 @@ package body Sem_Ch10 is
 
                      elsif not Analyzed (Cunit (Un))
                        and then Un /= Main_Unit
-                       and then not Fatal_Error (Un)
+                       and then Fatal_Error (Un) /= Error_Detected
                      then
                         Style_Check := False;
                         Semantics (Cunit (Un));
@@ -1623,7 +1623,8 @@ package body Sem_Ch10 is
          --  All done if we successfully loaded the subunit
 
          if Unum /= No_Unit
-           and then (not Fatal_Error (Unum) or else Try_Semantics)
+           and then (Fatal_Error (Unum) /= Error_Detected
+                      or else Try_Semantics)
          then
             Comp_Unit := Cunit (Unum);
 
@@ -1860,7 +1861,9 @@ package body Sem_Ch10 is
 
                   --  Analyze the unit if semantics active
 
-                  if not Fatal_Error (Unum) or else Try_Semantics then
+                  if Fatal_Error (Unum) /= Error_Detected
+                    or else Try_Semantics
+                  then
                      Analyze_Subunit (Comp_Unit);
                   end if;
                end if;
@@ -5442,7 +5445,7 @@ package body Sem_Ch10 is
       else
          Compiler_State := Analyzing; -- reset after load
 
-         if not Fatal_Error (Unum) or else Try_Semantics then
+         if Fatal_Error (Unum) /= Error_Detected or else Try_Semantics then
             if Debug_Flag_L then
                Write_Str ("*** Loaded generic body");
                Write_Eol;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 10b0062..7d0ca02 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7770,7 +7770,7 @@ package body Sem_Ch13 is
                --  at the end of the private part and has the wrong visibility.
 
                Set_Parent (Exp, N);
-               Preanalyze_Assert_Expression (Exp, Standard_Boolean);
+               Preanalyze_Assert_Expression (Exp, Any_Boolean);
 
                --  A class-wide invariant may be inherited in a separate unit,
                --  where the corresponding expression cannot be resolved by
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7699a6f..5aa5fe0 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19420,15 +19420,27 @@ package body Sem_Ch3 is
 
       begin
          if Nkind (Parent (Priv_T)) = N_Private_Extension_Declaration
-           and then not Limited_Present (Parent (Priv_T))
-           and then not Synchronized_Present (Parent (Priv_T))
            and then Nkind (Orig_Decl) = N_Full_Type_Declaration
            and then Nkind
              (Type_Definition (Orig_Decl)) = N_Derived_Type_Definition
-           and then Limited_Present (Type_Definition (Orig_Decl))
          then
-            Error_Msg_N
-              ("full view of non-limited extension cannot be limited", N);
+            if not Limited_Present (Parent (Priv_T))
+              and then not Synchronized_Present (Parent (Priv_T))
+              and then Limited_Present (Type_Definition (Orig_Decl))
+            then
+               Error_Msg_N
+                ("full view of non-limited extension cannot be limited", N);
+
+            --  Conversely, if the partial view carries the limited keyword,
+            --  the full view must as well, even if it may be redundant.
+
+            elsif Limited_Present (Parent (Priv_T))
+              and then not Limited_Present (Type_Definition (Orig_Decl))
+            then
+               Error_Msg_N
+                ("full view of limited extension must be explicitly limited",
+                 N);
+            end if;
          end if;
       end;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8951059c..0567c17 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11783,7 +11783,7 @@ package body Sem_Prag is
                  Make_If_Statement (Eloc,
                    Condition =>
                      Make_And_Then (Eloc,
-                       Left_Opnd  => New_Occurrence_Of (Standard_False, Eloc),
+                       Left_Opnd  => Make_Identifier (Eloc, Name_False),
                        Right_Opnd => Expr),
                    Then_Statements => New_List (
                      Make_Null_Statement (Eloc))));
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 5096c6a..b51a280 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6310,11 +6310,14 @@ package body Sem_Res is
 
       --  Check for calling a function with OUT or IN OUT parameter when the
       --  calling context (us right now) is not Ada 2012, so does not allow
-      --  OUT or IN OUT parameters in function calls.
+      --  OUT or IN OUT parameters in function calls. Functions declared in
+      --  a predefined unit are OK, as they may be called indirectly from a
+      --  user-declared instantiation.
 
       if Ada_Version < Ada_2012
         and then Ekind (Nam) = E_Function
         and then Has_Out_Or_In_Out_Parameter (Nam)
+        and then not In_Predefined_Unit (Nam)
       then
          Error_Msg_NE ("& has at least one OUT or `IN OUT` parameter", N, Nam);
          Error_Msg_N ("\call to this function only allowed in Ada 2012", N);