[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 10 Sep 2013 15:21:28 +0000 (17:21 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 10 Sep 2013 15:21:28 +0000 (17:21 +0200)
2013-09-10  Robert Dewar  <dewar@adacore.com>

* sinput.adb (Check_For_BOM): Avoid reading past end of file.

2013-09-10  Robert Dewar  <dewar@adacore.com>

* errout.adb (Error_Msg_Ada_2012_Feature): New procedure.
* errout.ads (Error_Msg_Ada_2012_Feature): New procedure.
* inline.ads: Save/Restore Ada_Version_Pragma.
* opt.adb: Save/Restore Ada_Version_Pragma.
* opt.ads (Ada_Version_Pragma): New variable.
* par-ch11.adb, par-ch12.adb, par-ch13.adb, par-ch4.adb, par-ch5.adb,
par-ch6.adb, par-ch8.adb, par-prag.adb: Use Error_Msg_Ada_2012_Feature.
* prj.adb: Initialize Ada_Version_Pragma.
* sem_attr.adb: Use Error_Msg_Ada_2012_Feature.
* sem_ch12.adb, sem_ch8.adb: Save/restore Ada_Version_Pragma.
* sem_prag.adb (Analyze_Pragma, cases Ada_xx): Set Ada_Version_Pragma.
* switch-c.adb: Initialize Ada_Version_Pragma.
* sem_ch12.adb: Minor reformatting.

2013-09-10  Ed Schonberg  <schonberg@adacore.com>

* sem_ch3.adb (Process_Subtype): Discard constraint on access
to class-wide type. Such constraints are not supported and are
considered a language pathology.

From-SVN: r202466

22 files changed:
gcc/ada/ChangeLog
gcc/ada/errout.adb
gcc/ada/errout.ads
gcc/ada/inline.ads
gcc/ada/opt.adb
gcc/ada/opt.ads
gcc/ada/par-ch11.adb
gcc/ada/par-ch12.adb
gcc/ada/par-ch13.adb
gcc/ada/par-ch4.adb
gcc/ada/par-ch5.adb
gcc/ada/par-ch6.adb
gcc/ada/par-ch8.adb
gcc/ada/par-prag.adb
gcc/ada/prj.adb
gcc/ada/sem_attr.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_prag.adb
gcc/ada/sinput.adb
gcc/ada/switch-c.adb

index b040b31..1ebe97c 100644 (file)
@@ -1,5 +1,31 @@
 2013-09-10  Robert Dewar  <dewar@adacore.com>
 
+       * sinput.adb (Check_For_BOM): Avoid reading past end of file.
+
+2013-09-10  Robert Dewar  <dewar@adacore.com>
+
+       * errout.adb (Error_Msg_Ada_2012_Feature): New procedure.
+       * errout.ads (Error_Msg_Ada_2012_Feature): New procedure.
+       * inline.ads: Save/Restore Ada_Version_Pragma.
+       * opt.adb: Save/Restore Ada_Version_Pragma.
+       * opt.ads (Ada_Version_Pragma): New variable.
+       * par-ch11.adb, par-ch12.adb, par-ch13.adb, par-ch4.adb, par-ch5.adb,
+       par-ch6.adb, par-ch8.adb, par-prag.adb: Use Error_Msg_Ada_2012_Feature.
+       * prj.adb: Initialize Ada_Version_Pragma.
+       * sem_attr.adb: Use Error_Msg_Ada_2012_Feature.
+       * sem_ch12.adb, sem_ch8.adb: Save/restore Ada_Version_Pragma.
+       * sem_prag.adb (Analyze_Pragma, cases Ada_xx): Set Ada_Version_Pragma.
+       * switch-c.adb: Initialize Ada_Version_Pragma.
+       * sem_ch12.adb: Minor reformatting.
+
+2013-09-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Process_Subtype): Discard constraint on access
+       to class-wide type. Such constraints are not supported and are
+       considered a language pathology.
+
+2013-09-10  Robert Dewar  <dewar@adacore.com>
+
        * gnatbind.adb: Correct starting date in --version string.
        * gnatdll.adb: Use Check_Version_And_Help_G to implement --help
        and --version.
index b32f6a1..a1e2714 100644 (file)
@@ -476,6 +476,24 @@ package body Errout is
       end;
    end Error_Msg;
 
+   --------------------------------
+   -- Error_Msg_Ada_2012_Feature --
+   --------------------------------
+
+   procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr) is
+   begin
+      if Ada_Version < Ada_2012 then
+         Error_Msg (Feature & " is an Ada 2012 feature", Loc);
+
+         if No (Ada_Version_Pragma) then
+            Error_Msg ("\unit must be compiled with -gnat2012 switch", Loc);
+         else
+            Error_Msg_Sloc := Sloc (Ada_Version_Pragma);
+            Error_Msg ("\incompatible with Ada version set#", Loc);
+         end if;
+      end if;
+   end Error_Msg_Ada_2012_Feature;
+
    ------------------
    -- Error_Msg_AP --
    ------------------
index 9afc4df..e267302 100644 (file)
@@ -343,7 +343,8 @@ package Errout is
    --      generation of code in the presence of the -gnatQ switch. If the
    --      insertion character | appears, the message is considered to be
    --      non-serious, and does not cause Serious_Errors_Detected to be
-   --      incremented (so expansion is not prevented by such a msg).
+   --      incremented (so expansion is not prevented by such a msg). This
+   --      insertion character is ignored in continuation messages.
 
    --    Insertion character ~ (Tilde: insert string)
    --      Indicates that Error_Msg_String (1 .. Error_Msg_Strlen) is to be
@@ -820,6 +821,14 @@ package Errout is
    --  Posts an error on the protected type declaration Typ indicating wrong
    --  mode of the first formal of protected type primitive Subp.
 
+   procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
+   --  If not operating in Ada 2012 mode, posts errors complaining that Feature
+   --  is only supported in Ada 2012, with appropriate suggestions to fix this.
+   --  Loc is the location at which the flag is to be posted. Feature, which
+   --  appears at the start of the first generated message, may contain error
+   --  message insertion characters in the normal manner, and in particular
+   --  may start with | to flag a non-serious error.
+
    procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg;
    --  Debugging routine to dump an error message
 
index f3750a8..d34a7f1 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -89,6 +89,9 @@ package Inline is
       --  The body must be compiled with the same language version as the
       --  spec. The version may be set by a configuration pragma in a separate
       --  file or in the current file, and may differ from body to body.
+
+      Version_Pragma : Node_Id;
+      --  This is linked with the Version value
    end record;
 
    package Pending_Instantiations is new Table.Table (
index 1fc43cc..9f1f2d8 100644 (file)
@@ -54,6 +54,7 @@ package body Opt is
    procedure Register_Opt_Config_Switches is
    begin
       Ada_Version_Config                    := Ada_Version;
+      Ada_Version_Pragma_Config             := Ada_Version_Pragma;
       Ada_Version_Explicit_Config           := Ada_Version_Explicit;
       Assertions_Enabled_Config             := Assertions_Enabled;
       Assume_No_Invalid_Values_Config       := Assume_No_Invalid_Values;
@@ -87,6 +88,7 @@ package body Opt is
    procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
    begin
       Ada_Version                    := Save.Ada_Version;
+      Ada_Version_Pragma             := Save.Ada_Version_Pragma;
       Ada_Version_Explicit           := Save.Ada_Version_Explicit;
       Assertions_Enabled             := Save.Assertions_Enabled;
       Assume_No_Invalid_Values       := Save.Assume_No_Invalid_Values;
@@ -122,6 +124,7 @@ package body Opt is
    procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
    begin
       Save.Ada_Version                    := Ada_Version;
+      Save.Ada_Version_Pragma             := Ada_Version_Pragma;
       Save.Ada_Version_Explicit           := Ada_Version_Explicit;
       Save.Assertions_Enabled             := Assertions_Enabled;
       Save.Assume_No_Invalid_Values       := Assume_No_Invalid_Values;
@@ -161,6 +164,7 @@ package body Opt is
          --  the configuration setting even in a run time unit.
 
          Ada_Version                 := Ada_Version_Runtime;
+         Ada_Version_Pragma          := Empty;
          Dynamic_Elaboration_Checks  := False;
          Extensions_Allowed          := True;
          External_Name_Exp_Casing    := As_Is;
@@ -188,6 +192,7 @@ package body Opt is
 
       else
          Ada_Version                 := Ada_Version_Config;
+         Ada_Version_Pragma          := Ada_Version_Pragma_Config;
          Ada_Version_Explicit        := Ada_Version_Explicit_Config;
          Assertions_Enabled          := Assertions_Enabled_Config;
          Assume_No_Invalid_Values    := Assume_No_Invalid_Values_Config;
index f515dc7..605dc89 100644 (file)
@@ -131,6 +131,10 @@ package Opt is
    --  compiler switches, or implicitly (to Ada_Version_Runtime) when a
    --  predefined or internal file is compiled.
 
+   Ada_Version_Pragma : Node_Id := Empty;
+   --  Reflects the Ada_xxx pragma that resulted in setting Ada_Version. Used
+   --  to specialize error messages complaining about the Ada version in use.
+
    Ada_Version_Explicit : Ada_Version_Type := Ada_Version_Default;
    --  GNAT
    --  Like Ada_Version, but does not get set implicitly for predefined
@@ -1737,6 +1741,9 @@ package Opt is
    --  predefined units (which are always compiled in the most up to date
    --  version of Ada).
 
+   Ada_Version_Pragma_Config : Node_Id;
+   --  This will be set non empty if it is set by a configuration pragma
+
    Ada_Version_Explicit_Config : Ada_Version_Type;
    --  GNAT
    --  This is set in the same manner as Ada_Version_Config. The difference is
@@ -2019,6 +2026,7 @@ private
    type Config_Switches_Type is record
       Ada_Version                    : Ada_Version_Type;
       Ada_Version_Explicit           : Ada_Version_Type;
+      Ada_Version_Pragma             : Node_Id;
       Assertions_Enabled             : Boolean;
       Assume_No_Invalid_Values       : Boolean;
       Check_Float_Overflow           : Boolean;
index f0537f2..61df3ee 100644 (file)
@@ -213,11 +213,7 @@ package body Ch11 is
       Raise_Node : Node_Id;
 
    begin
-      if Ada_Version < Ada_2012 then
-         Error_Msg_SC ("raise expression is an Ada 2012 feature");
-         Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
-      end if;
-
+      Error_Msg_Ada_2012_Feature ("raise expression", Token_Ptr);
       Raise_Node := New_Node (N_Raise_Expression, Token_Ptr);
       Scan; -- past RAISE
 
index ed6e314..cf75f04 100644 (file)
@@ -546,12 +546,8 @@ package body Ch12 is
 
          Scan; -- past semicolon
 
-         if Ada_Version < Ada_2012 then
-            Error_Msg_N
-              ("`formal incomplete type` is an Ada 2012 feature", Decl_Node);
-            Error_Msg_N
-              ("\unit must be compiled with -gnat2012 switch", Decl_Node);
-         end if;
+         Error_Msg_Ada_2012_Feature
+           ("formal incomplete type", Sloc (Decl_Node));
 
          Set_Formal_Type_Definition
            (Decl_Node,
@@ -564,13 +560,9 @@ package body Ch12 is
 
       Def_Node := P_Formal_Type_Definition;
 
-      if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition
-        and then Ada_Version < Ada_2012
-      then
-         Error_Msg_N
-           ("`formal incomplete type` is an Ada 2012 feature", Decl_Node);
-         Error_Msg_N
-           ("\unit must be compiled with -gnat2012 switch", Decl_Node);
+      if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition then
+         Error_Msg_Ada_2012_Feature
+           ("formal incomplete type", Sloc (Decl_Node));
       end if;
 
       if Def_Node /= Error then
index 9520644..26b8056 100644 (file)
@@ -128,8 +128,7 @@ package body Ch13 is
 
             if Result then
                Restore_Scan_State (Scan_State);
-               Error_Msg_SC ("|aspect specification is an Ada 2012 feature");
-               Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
+               Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr);
                return True;
             end if;
          end if;
index 38fd00e..5766639 100644 (file)
@@ -2672,18 +2672,12 @@ package body Ch4 is
       Node1  : Node_Id;
 
    begin
-      if Ada_Version < Ada_2012 then
-         Error_Msg_SC ("quantified expression is an Ada 2012 feature");
-         Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
-      end if;
-
+      Error_Msg_Ada_2012_Feature ("quantified expression", Token_Ptr);
       Scan;  --  past FOR
-
       Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
 
       if Token = Tok_All then
          Set_All_Present (Node1);
-
       elsif Token /= Tok_Some then
          Error_Msg_AP ("missing quantifier");
          raise Error_Resync;
@@ -2960,14 +2954,9 @@ package body Ch4 is
          Set_Subpool_Handle_Name (Alloc_Node, P_Name);
          T_Right_Paren;
 
-         if Ada_Version < Ada_2012 then
-            Error_Msg_N
-              ("|subpool specification is an Ada 2012 feature",
-               Subpool_Handle_Name (Alloc_Node));
-            Error_Msg_N
-              ("\|unit must be compiled with -gnat2012 switch",
-               Subpool_Handle_Name (Alloc_Node));
-         end if;
+         Error_Msg_Ada_2012_Feature
+           ("|subpool specification",
+            Sloc (Subpool_Handle_Name (Alloc_Node)));
       end if;
 
       Null_Exclusion_Present := P_Null_Exclusion;
@@ -3006,11 +2995,7 @@ package body Ch4 is
       Save_State : Saved_Scan_State;
 
    begin
-      if Ada_Version < Ada_2012 then
-         Error_Msg_SC ("|case expression is an Ada 2012 feature");
-         Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
-      end if;
-
+      Error_Msg_Ada_2012_Feature ("|case expression", Token_Ptr);
       Scan; -- past CASE
       Case_Node :=
         Make_Case_Expression (Loc,
@@ -3096,12 +3081,7 @@ package body Ch4 is
 
    begin
       Inside_If_Expression := Inside_If_Expression + 1;
-
-      if Token = Tok_If and then Ada_Version < Ada_2012 then
-         Error_Msg_SC ("|if expression is an Ada 2012 feature");
-         Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
-      end if;
-
+      Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
       Scan; -- past IF or ELSIF
       Append_To (Exprs, P_Condition);
       TF_Then;
@@ -3182,11 +3162,7 @@ package body Ch4 is
       --  Set case
 
       if Token = Tok_Vertical_Bar then
-         if Ada_Version < Ada_2012 then
-            Error_Msg_SC ("set notation is an Ada 2012 feature");
-            Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
-         end if;
-
+         Error_Msg_Ada_2012_Feature ("set notation", Token_Ptr);
          Set_Alternatives (N, New_List (Alt));
          Set_Right_Opnd   (N, Empty);
 
index e9b0a2c..94c5bd4 100644 (file)
@@ -1656,10 +1656,7 @@ package body Ch5 is
       --  during analysis of the loop parameter specification.
 
       if Token = Tok_Of or else Token = Tok_Colon then
-         if Ada_Version < Ada_2012 then
-            Error_Msg_SC ("iterator is an Ada 2012 feature");
-         end if;
-
+         Error_Msg_Ada_2012_Feature ("iterator", Token_Ptr);
          return P_Iterator_Specification (ID_Node);
       end if;
 
index f6aacd1..f060b3f 100644 (file)
@@ -834,12 +834,8 @@ package body Ch6 is
 
                   --  Check we are in Ada 2012 mode
 
-                  if Ada_Version < Ada_2012 then
-                     Error_Msg_SC
-                       ("expression function is an Ada 2012 feature!");
-                     Error_Msg_SC
-                       ("\unit must be compiled with -gnat2012 switch!");
-                  end if;
+                  Error_Msg_Ada_2012_Feature
+                    ("!expression function", Token_Ptr);
 
                   --  Catch an illegal placement of the aspect specification
                   --  list:
@@ -1467,7 +1463,8 @@ package body Ch6 is
 
                if Token = Tok_Aliased then
                   if Ada_Version < Ada_2012 then
-                     Error_Msg_SC ("ALIASED parameter is an Ada 2012 feature");
+                     Error_Msg_Ada_2012_Feature
+                       ("ALIASED parameter", Token_Ptr);
                   else
                      Set_Aliased_Present (Specification_Node);
                   end if;
index fb2bf17..89a2bb4 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -110,14 +110,9 @@ package body Ch8 is
 
    begin
       if Token = Tok_All then
-         if Ada_Version < Ada_2012 then
-            Error_Msg_SC ("|`USE ALL TYPE` is an Ada 2012 feature");
-            Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
-         end if;
-
+         Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
          All_Present := True;
          Scan; -- past ALL
-
       else
          All_Present := False;
       end if;
index 4d01db0..5de6ecc 100644 (file)
@@ -307,6 +307,7 @@ begin
       when Pragma_Ada_83 =>
          Ada_Version := Ada_83;
          Ada_Version_Explicit := Ada_83;
+         Ada_Version_Pragma := Pragma_Node;
 
       ------------
       -- Ada_95 --
@@ -319,6 +320,7 @@ begin
       when Pragma_Ada_95 =>
          Ada_Version := Ada_95;
          Ada_Version_Explicit := Ada_95;
+         Ada_Version_Pragma := Pragma_Node;
 
       ---------------------
       -- Ada_05/Ada_2005 --
@@ -333,6 +335,7 @@ begin
          if Arg_Count = 0 then
             Ada_Version := Ada_2005;
             Ada_Version_Explicit := Ada_2005;
+            Ada_Version_Pragma := Pragma_Node;
          end if;
 
       ---------------------
@@ -348,6 +351,7 @@ begin
          if Arg_Count = 0 then
             Ada_Version := Ada_2012;
             Ada_Version_Explicit := Ada_2012;
+            Ada_Version_Pragma := Pragma_Node;
          end if;
 
       -----------
index 9e0e0aa..b98f711 100644 (file)
@@ -959,6 +959,7 @@ package body Prj is
          --  identifiers.
 
          Opt.Ada_Version := Opt.Ada_95;
+         Opt.Ada_Version_Pragma := Empty;
 
          Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
          Set_Name_Table_Byte (Name_Extends,  Token_Type'Pos (Tok_Extends));
index f5d12ed..ae58c9d 100644 (file)
@@ -890,13 +890,8 @@ package body Sem_Attr is
 
       procedure Check_Ada_2012_Attribute is
       begin
-         if Ada_Version < Ada_2012 then
-            Error_Msg_Name_1 := Aname;
-            Error_Msg_N
-              ("attribute % is an Ada 2012 feature", N);
-            Error_Msg_N
-              ("\unit must be compiled with -gnat2012 switch", N);
-         end if;
+         Error_Msg_Name_1 := Aname;
+         Error_Msg_Ada_2012_Feature ("attribute %", Sloc (N));
       end Check_Ada_2012_Attribute;
 
       --------------------------------
index b9c41fa..819f573 100644 (file)
@@ -3592,8 +3592,8 @@ package body Sem_Ch12 is
 
          Append (Unit_Renaming, Renaming_List);
 
-         --  The renaming declarations are the first local declarations of
-         --  the new unit.
+         --  The renaming declarations are the first local declarations of the
+         --  new unit.
 
          if Is_Non_Empty_List (Visible_Declarations (Act_Spec)) then
             Insert_List_Before
@@ -3894,7 +3894,8 @@ package body Sem_Ch12 is
                    Current_Sem_Unit         => Current_Sem_Unit,
                    Scope_Suppress           => Scope_Suppress,
                    Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
-                   Version                  => Ada_Version));
+                   Version                  => Ada_Version,
+                   Version_Pragma           => Ada_Version_Pragma));
             end if;
          end if;
 
@@ -4238,7 +4239,8 @@ package body Sem_Ch12 is
                Current_Sem_Unit         => Current_Sem_Unit,
                Scope_Suppress           => Scope_Suppress,
                Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
-               Version                  => Ada_Version)),
+               Version                  => Ada_Version,
+               Version_Pragma           => Ada_Version_Pragma)),
             Inlined_Body => True);
 
          Pop_Scope;
@@ -4318,8 +4320,8 @@ package body Sem_Ch12 is
             end  loop;
          end if;
 
-         --  Restore status of instances. If one of them is a body, make
-         --  its local entities visible again.
+         --  Restore status of instances. If one of them is a body, make its
+         --  local entities visible again.
 
          declare
             E    : Entity_Id;
@@ -4354,7 +4356,8 @@ package body Sem_Ch12 is
                Current_Sem_Unit         => Current_Sem_Unit,
                Scope_Suppress           => Scope_Suppress,
                Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
-               Version                  => Ada_Version)),
+               Version                  => Ada_Version,
+               Version_Pragma           => Ada_Version_Pragma)),
             Inlined_Body => True);
       end if;
    end Inline_Instance_Body;
@@ -4410,7 +4413,8 @@ package body Sem_Ch12 is
              Current_Sem_Unit         => Current_Sem_Unit,
              Scope_Suppress           => Scope_Suppress,
              Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
-             Version                  => Ada_Version));
+             Version                  => Ada_Version,
+             Version_Pragma           => Ada_Version_Pragma));
          return True;
 
       --  Here if not inlined, or we ignore the inlining
@@ -4864,7 +4868,6 @@ package body Sem_Ch12 is
             --  subsequent construction of the body.
 
             if Need_Subprogram_Instance_Body (N, Act_Decl_Id) then
-
                Check_Forward_Instantiation (Gen_Decl);
 
                --  The wrapper package is always delayed, because it does not
@@ -9910,6 +9913,7 @@ package body Sem_Ch12 is
       Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top;
       Scope_Suppress           := Body_Info.Scope_Suppress;
       Opt.Ada_Version          := Body_Info.Version;
+      Opt.Ada_Version_Pragma   := Body_Info.Version_Pragma;
 
       if No (Gen_Body_Id) then
          Load_Parent_Of_Generic
@@ -10196,6 +10200,7 @@ package body Sem_Ch12 is
       Local_Suppress_Stack_Top := Body_Info.Local_Suppress_Stack_Top;
       Scope_Suppress           := Body_Info.Scope_Suppress;
       Opt.Ada_Version          := Body_Info.Version;
+      Opt.Ada_Version_Pragma   := Body_Info.Version_Pragma;
 
       if No (Gen_Body_Id) then
 
@@ -10926,9 +10931,7 @@ package body Sem_Ch12 is
 
          --  Ada 2005 (AI-251)
 
-         if Ada_Version >= Ada_2005
-           and then Is_Interface (Ancestor)
-         then
+         if Ada_Version >= Ada_2005 and then Is_Interface (Ancestor) then
             if not Interface_Present_In_Ancestor (Act_T, Ancestor) then
                Error_Msg_NE
                  ("(Ada 2005) expected type implementing & in instantiation",
@@ -12092,7 +12095,8 @@ package body Sem_Ch12 is
                               Scope_Suppress           => Scope_Suppress,
                               Local_Suppress_Stack_Top =>
                                 Local_Suppress_Stack_Top,
-                              Version                  => Ada_Version);
+                              Version                  => Ada_Version,
+                              Version_Pragma           => Ada_Version_Pragma);
 
                            --  Package instance
 
@@ -12128,12 +12132,12 @@ package body Sem_Ch12 is
                        ((Inst_Node                => Inst_Node,
                          Act_Decl                 => True_Parent,
                          Expander_Status          => Exp_Status,
-                         Current_Sem_Unit         =>
-                           Get_Code_Unit (Sloc (Inst_Node)),
+                         Current_Sem_Unit         => Get_Code_Unit
+                                                       (Sloc (Inst_Node)),
                          Scope_Suppress           => Scope_Suppress,
-                         Local_Suppress_Stack_Top =>
-                           Local_Suppress_Stack_Top,
-                           Version                => Ada_Version)),
+                         Local_Suppress_Stack_Top => Local_Suppress_Stack_Top,
+                         Version                  => Ada_Version,
+                         Version_Pragma           => Ada_Version_Pragma)),
                      Body_Optional => Body_Optional);
                end;
             end if;
index b3f99c4..2d8d5f7 100644 (file)
@@ -19043,6 +19043,27 @@ package body Sem_Ch3 is
 
          case Ekind (Base_Type (Subtype_Mark_Id)) is
             when Access_Kind =>
+
+               --  If this is a constraint on a class-wide type, discard it.
+               --  There is currently no way to express a partial discriminant
+               --  constraint on a type with unknown discriminants. This is
+               --  a pathology that the ACATS wisely decides not to test.
+
+               if Is_Class_Wide_Type (Designated_Type (Subtype_Mark_Id)) then
+                  if Comes_From_Source (S) then
+                     Error_Msg_N
+                       ("constraint on class-wide type ignored?",
+                        Constraint (S));
+                  end if;
+
+                  if Nkind (P) = N_Subtype_Declaration then
+                     Set_Subtype_Indication (P,
+                        New_Occurrence_Of (Subtype_Mark_Id, Sloc (S)));
+                  end if;
+
+                  return Subtype_Mark_Id;
+               end if;
+
                Constrain_Access (Def_Id, S, Related_Nod);
 
                if Expander_Active
index 27ccc2d..1e6470b 100644 (file)
@@ -1773,6 +1773,7 @@ package body Sem_Ch8 is
       Old_S       : Entity_Id                 := Empty;
       Rename_Spec : Entity_Id;
       Save_AV     : constant Ada_Version_Type := Ada_Version;
+      Save_AVP    : constant Node_Id          := Ada_Version_Pragma;
       Save_AV_Exp : constant Ada_Version_Type := Ada_Version_Explicit;
       Spec        : constant Node_Id          := Specification (N);
 
@@ -2582,6 +2583,7 @@ package body Sem_Ch8 is
       --  ???
 
       Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95);
+      Ada_Version_Pragma := Empty;
       Ada_Version_Explicit := Ada_Version;
 
       if No (Old_S) then
@@ -3039,6 +3041,7 @@ package body Sem_Ch8 is
       end if;
 
       Ada_Version := Save_AV;
+      Ada_Version_Pragma := Save_AVP;
       Ada_Version_Explicit := Save_AV_Exp;
    end Analyze_Subprogram_Renaming;
 
index 0cf4fc7..8d716aa 100644 (file)
@@ -8600,8 +8600,9 @@ package body Sem_Prag is
 
             --  Now set Ada 83 mode
 
-            Ada_Version := Ada_83;
-            Ada_Version_Explicit := Ada_Version;
+            Ada_Version          := Ada_83;
+            Ada_Version_Explicit := Ada_83;
+            Ada_Version_Pragma   := N;
 
          ------------
          -- Ada_95 --
@@ -8631,8 +8632,9 @@ package body Sem_Prag is
 
             --  Now set Ada 95 mode
 
-            Ada_Version := Ada_95;
-            Ada_Version_Explicit := Ada_Version;
+            Ada_Version          := Ada_95;
+            Ada_Version_Explicit := Ada_95;
+            Ada_Version_Pragma   := N;
 
          ---------------------
          -- Ada_05/Ada_2005 --
@@ -8679,6 +8681,7 @@ package body Sem_Prag is
 
                Ada_Version          := Ada_2005;
                Ada_Version_Explicit := Ada_2005;
+               Ada_Version_Pragma   := N;
             end if;
          end;
 
@@ -8728,6 +8731,7 @@ package body Sem_Prag is
 
                Ada_Version          := Ada_2012;
                Ada_Version_Explicit := Ada_2012;
+               Ada_Version_Pragma   := N;
             end if;
          end;
 
@@ -11602,6 +11606,7 @@ package body Sem_Prag is
             else
                Extensions_Allowed := False;
                Ada_Version := Ada_Version_Explicit;
+               Ada_Version_Pragma := Empty;
             end if;
 
          --------------
index 29be59a..a01c045 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -258,10 +258,20 @@ package body Sinput is
       BOM : BOM_Kind;
       Len : Natural;
       Tst : String (1 .. 5);
+      C   : Character;
 
    begin
       for J in 1 .. 5 loop
-         Tst (J) := Source (Scan_Ptr + Source_Ptr (J) - 1);
+         C := Source (Scan_Ptr + Source_Ptr (J) - 1);
+
+         --  Definitely no BOM if EOF character marks either end of file, or
+         --  an illegal non-BOM character if not at the end of file.
+
+         if C = EOF then
+            return;
+         end if;
+
+         Tst (J) := C;
       end loop;
 
       Read_BOM (Tst, Len, BOM, False);
index 2cca5d1..197be06 100644 (file)
@@ -781,8 +781,9 @@ package body Switch.C is
                --  implicit setting here, since for example, we want
                --  Preelaborate_05 treated as Preelaborate
 
-               Ada_Version := Ada_2012;
-               Ada_Version_Explicit := Ada_Version;
+               Ada_Version          := Ada_2012;
+               Ada_Version_Explicit := Ada_2012;
+               Ada_Version_Pragma   := Empty;
 
                --  Set default warnings and style checks for -gnatg
 
@@ -1214,6 +1215,7 @@ package body Switch.C is
                Extensions_Allowed   := True;
                Ada_Version          := Ada_Version_Type'Last;
                Ada_Version_Explicit := Ada_Version_Type'Last;
+               Ada_Version_Pragma   := Empty;
 
             --  -gnaty (style checks)
 
@@ -1326,8 +1328,9 @@ package body Switch.C is
                   Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
                else
                   Ptr := Ptr + 1;
-                  Ada_Version := Ada_83;
-                  Ada_Version_Explicit := Ada_Version;
+                  Ada_Version          := Ada_83;
+                  Ada_Version_Explicit := Ada_83;
+                  Ada_Version_Pragma   := Empty;
                end if;
 
             --  -gnat95
@@ -1343,8 +1346,9 @@ package body Switch.C is
                   Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
                else
                   Ptr := Ptr + 1;
-                  Ada_Version := Ada_95;
-                  Ada_Version_Explicit := Ada_Version;
+                  Ada_Version          := Ada_95;
+                  Ada_Version_Explicit := Ada_95;
+                  Ada_Version_Pragma   := Empty;
                end if;
 
             --  -gnat05
@@ -1360,8 +1364,9 @@ package body Switch.C is
                   Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
                else
                   Ptr := Ptr + 1;
-                  Ada_Version := Ada_2005;
-                  Ada_Version_Explicit := Ada_Version;
+                  Ada_Version          := Ada_2005;
+                  Ada_Version_Explicit := Ada_2005;
+                  Ada_Version_Pragma   := Empty;
                end if;
 
             --  -gnat12
@@ -1377,8 +1382,9 @@ package body Switch.C is
                   Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
                else
                   Ptr := Ptr + 1;
-                  Ada_Version := Ada_2012;
-                  Ada_Version_Explicit := Ada_Version;
+                  Ada_Version          := Ada_2012;
+                  Ada_Version_Explicit := Ada_2012;
+                  Ada_Version_Pragma   := Empty;
                end if;
 
             --  -gnat2005 and -gnat2012
@@ -1398,6 +1404,7 @@ package body Switch.C is
                end if;
 
                Ada_Version_Explicit := Ada_Version;
+               Ada_Version_Pragma   := Empty;
                Ptr := Ptr + 4;
 
             --  Switch cancellation, currently only -gnat-p is allowed.