OSDN Git Service

PR 33870
[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_prag.adb
index 5f4b95d..65ee287 100644 (file)
 --                                                                          --
 -- 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- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
 -- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
@@ -32,6 +31,7 @@
 
 with Atree;    use Atree;
 with Casing;   use Casing;
+with Checks;   use Checks;
 with Csets;    use Csets;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
@@ -2106,9 +2106,9 @@ package body Sem_Prag is
          begin
             --  Ada 2005 (AI-430): Check invalid attempt to change convention
             --  for an overridden dispatching operation. Technically this is
-            --  an amendment and should only be done in Ada 2005 mode.
-            --  However, this is clearly a mistake, since the problem that is
-            --  addressed by this AI is that there is a clear gap in the RM!
+            --  an amendment and should only be done in Ada 2005 mode. However,
+            --  this is clearly a mistake, since the problem that is addressed
+            --  by this AI is that there is a clear gap in the RM!
 
             if Is_Dispatching_Operation (E)
               and then Present (Overridden_Operation (E))
@@ -2138,10 +2138,10 @@ package body Sem_Prag is
                Set_Convention (Class_Wide_Type (E), C);
             end if;
 
-            --  If the entity is a record type, then check for special case
-            --  of C_Pass_By_Copy, which is treated the same as C except that
-            --  the special record flag is set. This convention is also only
-            --  permitted on record types (see AI95-00131).
+            --  If the entity is a record type, then check for special case of
+            --  C_Pass_By_Copy, which is treated the same as C except that the
+            --  special record flag is set. This convention is only permitted
+            --  on record types (see AI95-00131).
 
             if Cname = Name_C_Pass_By_Copy then
                if Is_Record_Type (E) then
@@ -2193,11 +2193,11 @@ package body Sem_Prag is
          elsif Is_Convention_Name (Cname) then
             C := Get_Convention_Id (Chars (Expression (Arg1)));
 
-         --  In DEC VMS, it seems that there is an undocumented feature
-         --  that any unrecognized convention is treated as the default,
-         --  which for us is convention C. It does not seem so terrible
-         --  to do this unconditionally, silently in the VMS case, and
-         --  with a warning in the non-VMS case.
+         --  In DEC VMS, it seems that there is an undocumented feature that
+         --  any unrecognized convention is treated as the default, which for
+         --  us is convention C. It does not seem so terrible to do this
+         --  unconditionally, silently in the VMS case, and with a warning
+         --  in the non-VMS case.
 
          else
             if Warn_On_Export_Import and not OpenVMS_On_Target then
@@ -2225,9 +2225,9 @@ package body Sem_Prag is
 
          E := Entity (Id);
 
-         --  Go to renamed subprogram if present, since convention applies
-         --  to the actual renamed entity, not to the renaming entity.
-         --  If subprogram is inherited, go to parent subprogram.
+         --  Go to renamed subprogram if present, since convention applies to
+         --  the actual renamed entity, not to the renaming entity. If the
+         --  subprogram is inherited, go to parent subprogram.
 
          if Is_Subprogram (E)
            and then Present (Alias (E))
@@ -2581,9 +2581,8 @@ package body Sem_Prag is
             then
                Error_Msg_Sloc := Sloc (Def_Id);
                Error_Pragma_Arg
-                 ("no initialization allowed for declaration of& #",
-                  "\imported entities cannot be initialized ('R'M' 'B.1(24))",
-                  Arg1);
+                 ("imported entities cannot be initialized (RM B.1(24))",
+                  "\no initialization allowed for & declared#", Arg1);
             else
                Set_Imported (Def_Id);
                Note_Possible_Modification (Arg_Internal);
@@ -2847,9 +2846,9 @@ package body Sem_Prag is
 
          --  Here we have the Export case which can set the entity as exported
 
-         --  But does not do so if the specified external name is null,
-         --  since that is taken as a signal in DEC Ada 83 (with which
-         --  we want to be compatible) to request no external name.
+         --  But does not do so if the specified external name is null, since
+         --  that is taken as a signal in DEC Ada 83 (with which we want to be
+         --  compatible) to request no external name.
 
          elsif Nkind (Arg_External) = N_String_Literal
            and then String_Length (Strval (Arg_External)) = 0
@@ -2942,7 +2941,6 @@ package body Sem_Prag is
 
                   if Present (Expressions (Arg_Mechanism)) then
                      Mname := First (Expressions (Arg_Mechanism));
-
                      while Present (Mname) loop
                         if No (Formal) then
                            Error_Pragma_Arg
@@ -2959,7 +2957,6 @@ package body Sem_Prag is
 
                   if Present (Component_Associations (Arg_Mechanism)) then
                      Massoc := First (Component_Associations (Arg_Mechanism));
-
                      while Present (Massoc) loop
                         Choice := First (Choices (Massoc));
 
@@ -3121,7 +3118,7 @@ package body Sem_Prag is
                Error_Msg_Sloc := Sloc (Def_Id);
                Error_Pragma_Arg
                  ("no initialization allowed for declaration of& #",
-                  "\imported entities cannot be initialized ('R'M' 'B.1(24))",
+                  "\imported entities cannot be initialized (RM B.1(24))",
                   Arg2);
 
             else
@@ -3243,9 +3240,9 @@ package body Sem_Prag is
                                              N_Subprogram_Renaming_Declaration
                      then
                         Error_Msg_Sloc := Sloc (Def_Id);
-                        Error_Msg_NE ("cannot import&#," &
-                           " already completed by a renaming",
-                           N, Def_Id);
+                        Error_Msg_NE
+                          ("cannot import&, renaming already provided for " &
+                           "declaration #", N, Def_Id);
                      end if;
                   end;
 
@@ -3698,7 +3695,6 @@ package body Sem_Prag is
                     and then Ekind (Scope (E)) = E_Package
                   then
                      Par := Parent (E);
-
                      while Present (Par) loop
                         if Nkind (Par) = N_Package_Body then
                            Error_Msg_Sloc  := Sloc (E);
@@ -3739,13 +3735,10 @@ package body Sem_Prag is
             end if;
 
             String_Val := Strval (Expr_Value_S (Link_Nam));
-
-            for J in 1 .. String_Length (String_Val) loop
-               Store_String_Char (Get_String_Char (String_Val, J));
-            end loop;
-
+            Store_String_Chars (String_Val);
             Link_Nam :=
-              Make_String_Literal (Sloc (Link_Nam), End_String);
+              Make_String_Literal (Sloc (Link_Nam),
+                Strval => End_String);
          end if;
 
          Set_Encoded_Interface_Name
@@ -3974,18 +3967,20 @@ package body Sem_Prag is
          --------------------------------
 
          procedure Suppress_Unsuppress_Echeck (E : Entity_Id; C : Check_Id) is
-            ESR : constant Entity_Check_Suppress_Record :=
-                    (Entity   => E,
-                     Check    => C,
-                     Suppress => Suppress_Case);
-
          begin
             Set_Checks_May_Be_Suppressed (E);
 
             if In_Package_Spec then
-               Global_Entity_Suppress.Append (ESR);
+               Push_Global_Suppress_Stack_Entry
+                 (Entity   => E,
+                  Check    => C,
+                  Suppress => Suppress_Case);
+
             else
-               Local_Entity_Suppress.Append (ESR);
+               Push_Local_Suppress_Stack_Entry
+                 (Entity   => E,
+                  Check    => C,
+                  Suppress => Suppress_Case);
             end if;
 
             --  If this is a first subtype, and the base type is distinct,
@@ -4013,11 +4008,11 @@ package body Sem_Prag is
          Check_No_Identifier (Arg1);
          Check_Arg_Is_Identifier (Arg1);
 
-         if not Is_Check_Name (Chars (Expression (Arg1))) then
+         C := Get_Check_Id (Chars (Expression (Arg1)));
+
+         if C = No_Check_Id then
             Error_Pragma_Arg
               ("argument of pragma% is not valid check name", Arg1);
-         else
-            C := Get_Check_Id (Chars (Expression (Arg1)));
          end if;
 
          if not Suppress_Case
@@ -4034,10 +4029,10 @@ package body Sem_Prag is
 
             if C = All_Checks then
 
-               --  For All_Checks, we set all specific checks with the
-               --  exception of Elaboration_Check, which is handled specially
-               --  because of not wanting All_Checks to have the effect of
-               --  deactivating static elaboration order processing.
+               --  For All_Checks, we set all specific predefined checks with
+               --  the exception of Elaboration_Check, which is handled
+               --  specially because of not wanting All_Checks to have the
+               --  effect of deactivating static elaboration order processing.
 
                for J in Scope_Suppress'Range loop
                   if J /= Elaboration_Check then
@@ -4045,24 +4040,23 @@ package body Sem_Prag is
                   end if;
                end loop;
 
-            --  If not All_Checks, just set appropriate entry. Note that we
-            --  will set Elaboration_Check if this is explicitly specified.
+            --  If not All_Checks, and predefined check, then set appropriate
+            --  scope entry. Note that we will set Elaboration_Check if this
+            --  is explicitly specified.
 
-            else
+            elsif C in Predefined_Check_Id then
                Scope_Suppress (C) := Suppress_Case;
             end if;
 
-            --  Also make an entry in the Local_Entity_Suppress table. See
-            --  extended description in the package spec of Sem for details.
+            --  Also make an entry in the Local_Entity_Suppress table
 
-            Local_Entity_Suppress.Append
-              ((Entity   => Empty,
-                Check    => C,
-                Suppress => Suppress_Case));
+            Push_Local_Suppress_Stack_Entry
+              (Entity   => Empty,
+               Check    => C,
+               Suppress => Suppress_Case);
 
-         --  Case of two arguments present, where the check is
-         --  suppressed for a specified entity (given as the second
-         --  argument of the pragma)
+         --  Case of two arguments present, where the check is suppressed for
+         --  a specified entity (given as the second argument of the pragma)
 
          else
             Check_Optional_Identifier (Arg2, Name_On);
@@ -4091,7 +4085,7 @@ package body Sem_Prag is
               and then Scope (E) /= Current_Scope
             then
                Error_Pragma_Arg
-                 ("entity in pragma% is not in package spec ('R'M 11.5(7))",
+                 ("entity in pragma% is not in package spec (RM 11.5(7))",
                   Arg2);
             end if;
 
@@ -4277,18 +4271,23 @@ package body Sem_Prag is
 
       procedure Set_Imported (E : Entity_Id) is
       begin
-         Error_Msg_Sloc  := Sloc (E);
+         --  Error message if already imported or exported
 
          if Is_Exported (E) or else Is_Imported (E) then
-            Error_Msg_NE ("import of& declared# not allowed", N, E);
-
             if Is_Exported (E) then
-               Error_Msg_N ("\entity was previously exported", N);
+               Error_Msg_NE ("entity& was previously exported", N, E);
             else
-               Error_Msg_N ("\entity was previously imported", N);
+               Error_Msg_NE ("entity& was previously imported", N, E);
             end if;
 
-            Error_Pragma ("\(pragma% applies to all previous entities)");
+            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_N
+              ("\(pragma% applies to all previous entities)", N);
+
+            Error_Msg_Sloc  := Sloc (E);
+            Error_Msg_NE ("\import not allowed for& declared#", N, E);
+
+         --  Here if not previously imported or exported, OK to import
 
          else
             Set_Is_Imported (E);
@@ -4515,16 +4514,32 @@ package body Sem_Prag is
    --  Start of processing for Analyze_Pragma
 
    begin
+      --  Deal with unrecognized pragma
+
       if not Is_Pragma_Name (Chars (N)) then
          if Warn_On_Unrecognized_Pragma then
-            Error_Pragma ("unrecognized pragma%?");
-         else
-            return;
+            Error_Msg_Name_1 := Chars (N);
+            Error_Msg_N ("?unrecognized pragma%!", N);
+
+            for PN in First_Pragma_Name .. Last_Pragma_Name loop
+               if Is_Bad_Spelling_Of
+                 (Get_Name_String (Chars (N)),
+                  Get_Name_String (PN))
+               then
+                  Error_Msg_Name_1 := PN;
+                  Error_Msg_N ("\?possible misspelling of %!", N);
+                  exit;
+               end if;
+            end loop;
          end if;
-      else
-         Prag_Id := Get_Pragma_Id (Chars (N));
+
+         return;
       end if;
 
+      --  Here to start processing for recognized pragma
+
+      Prag_Id := Get_Pragma_Id (Chars (N));
+
       --  Preset arguments
 
       Arg1 := Empty;
@@ -4598,9 +4613,25 @@ package body Sem_Prag is
 
          when Pragma_Ada_83 =>
             GNAT_Pragma;
+            Check_Arg_Count (0);
+
+            --  We really should check unconditionally for proper configuration
+            --  pragma placement, since we really don't want mixed Ada modes
+            --  within a single unit, and the GNAT reference manual has always
+            --  said this was a configuration pragma, but we did not check and
+            --  are hesitant to add the check now.
+
+            --  However, we really cannot tolerate mixing Ada 2005 with Ada 83
+            --  or Ada 95, so we must check if we are in Ada 2005 mode.
+
+            if Ada_Version >= Ada_05 then
+               Check_Valid_Configuration_Pragma;
+            end if;
+
+            --  Now set Ada 83 mode
+
             Ada_Version := Ada_83;
             Ada_Version_Explicit := Ada_Version;
-            Check_Arg_Count (0);
 
          ------------
          -- Ada_95 --
@@ -4613,9 +4644,25 @@ package body Sem_Prag is
 
          when Pragma_Ada_95 =>
             GNAT_Pragma;
+            Check_Arg_Count (0);
+
+            --  We really should check unconditionally for proper configuration
+            --  pragma placement, since we really don't want mixed Ada modes
+            --  within a single unit, and the GNAT reference manual has always
+            --  said this was a configuration pragma, but we did not check and
+            --  are hesitant to add the check now.
+
+            --  However, we really cannot tolerate mixing Ada 2005 with Ada 83
+            --  or Ada 95, so we must check if we are in Ada 2005 mode.
+
+            if Ada_Version >= Ada_05 then
+               Check_Valid_Configuration_Pragma;
+            end if;
+
+            --  Now set Ada 95 mode
+
             Ada_Version := Ada_95;
             Ada_Version_Explicit := Ada_Version;
-            Check_Arg_Count (0);
 
          ---------------------
          -- Ada_05/Ada_2005 --
@@ -4648,6 +4695,17 @@ package body Sem_Prag is
 
             else
                Check_Arg_Count (0);
+
+               --  For Ada_2005 we unconditionally enforce the documented
+               --  configuration pragma placement, since we do not want to
+               --  tolerate mixed modes in a unit involving Ada 2005. That
+               --  would cause real difficulties for those cases where there
+               --  are incompatibilities between Ada 95 and Ada 2005.
+
+               Check_Valid_Configuration_Pragma;
+
+               --  Now set Ada 2005 mode
+
                Ada_Version := Ada_05;
                Ada_Version_Explicit := Ada_05;
             end if;
@@ -4702,10 +4760,11 @@ package body Sem_Prag is
             Check_Arg_Is_Identifier (Arg1);
 
             declare
-               Arg : Node_Id := Arg2;
+               Arg : Node_Id;
                Exp : Node_Id;
 
             begin
+               Arg := Arg2;
                while Present (Arg) loop
                   Exp := Expression (Arg);
                   Analyze (Exp);
@@ -5174,6 +5233,40 @@ package body Sem_Prag is
             end if;
          end C_Pass_By_Copy;
 
+         ----------------
+         -- Check_Name --
+         ----------------
+
+         --  pragma Check_Name (check_IDENTIFIER);
+
+         when Pragma_Check_Name =>
+            Check_No_Identifiers;
+            GNAT_Pragma;
+            Check_Valid_Configuration_Pragma;
+            Check_Arg_Count (1);
+            Check_Arg_Is_Identifier (Arg1);
+
+            declare
+               Nam : constant Name_Id := Chars (Expression (Arg1));
+
+            begin
+               for J in Check_Names.First .. Check_Names.Last loop
+                  if Check_Names.Table (J) = Nam then
+                     return;
+                  end if;
+               end loop;
+
+               Check_Names.Append (Nam);
+            end;
+
+         ---------------------
+         -- CIL_Constructor --
+         ---------------------
+
+         --  pragma CIL_Constructor ([Entity =>] LOCAL_NAME);
+
+         --  Processing for this pragma is shared with Java_Constructor
+
          -------------
          -- Comment --
          -------------
@@ -5217,6 +5310,15 @@ package body Sem_Prag is
          when Pragma_Compile_Time_Warning =>
             Process_Compile_Time_Warning_Or_Error;
 
+         -------------------
+         -- Compiler_Unit --
+         -------------------
+
+         when Pragma_Compiler_Unit =>
+            GNAT_Pragma;
+            Check_Arg_Count (0);
+            Set_Is_Compiler_Unit (Get_Source_Unit (N));
+
          -----------------------------
          -- Complete_Representation --
          -----------------------------
@@ -5275,6 +5377,13 @@ package body Sem_Prag is
 
             else
                Set_Has_Complex_Representation (Base_Type (E));
+
+               --  We need to treat the type has having a non-standard
+               --  representation, for back-end purposes, even though in
+               --  general a complex will have the default representation
+               --  of a record with two real components.
+
+               Set_Has_Non_Standard_Rep (Base_Type (E));
             end if;
          end Complex_Representation;
 
@@ -5410,6 +5519,8 @@ package body Sem_Prag is
          when Pragma_Convention => Convention : declare
             C : Convention_Id;
             E : Entity_Id;
+            pragma Warnings (Off, C);
+            pragma Warnings (Off, E);
          begin
             Check_Arg_Order ((Name_Convention, Name_Entity));
             Check_Ada_83_Warning;
@@ -5435,7 +5546,7 @@ package body Sem_Prag is
             Check_Optional_Identifier (Arg1, Name_Name);
             Check_Optional_Identifier (Arg2, Name_Convention);
             Check_Arg_Is_Identifier (Arg1);
-            Check_Arg_Is_Identifier (Arg1);
+            Check_Arg_Is_Identifier (Arg2);
             Idnam := Chars (Expression (Arg1));
             Cname := Chars (Expression (Arg2));
 
@@ -5850,7 +5961,6 @@ package body Sem_Prag is
             Arg := Arg1;
             Outr : while Present (Arg) loop
                Citem := First (List_Containing (N));
-
                Innr : while Citem /= N loop
                   if Nkind (Citem) = N_With_Clause
                     and then Same_Name (Name (Citem), Expression (Arg))
@@ -6043,6 +6153,8 @@ package body Sem_Prag is
             C      : Convention_Id;
             Def_Id : Entity_Id;
 
+            pragma Warnings (Off, C);
+
          begin
             Check_Ada_83_Warning;
             Check_Arg_Order
@@ -6388,7 +6500,7 @@ package body Sem_Prag is
                      null;
                   else
                      Error_Msg_Sloc := Sloc (System_Extend_Pragma_Arg);
-                     Error_Pragma ("pragma% conflicts with that at#");
+                     Error_Pragma ("pragma% conflicts with that #");
                   end if;
 
                else
@@ -6432,8 +6544,11 @@ package body Sem_Prag is
          --    [, [Link_Name     =>] static_string_EXPRESSION ]);
 
          when Pragma_External => External : declare
-            C      : Convention_Id;
-            Def_Id : Entity_Id;
+               Def_Id : Entity_Id;
+
+               C : Convention_Id;
+               pragma Warnings (Off, C);
+
          begin
             GNAT_Pragma;
             Check_Arg_Order
@@ -6747,6 +6862,17 @@ package body Sem_Prag is
             end;
          end Ident;
 
+         -----------------------
+         -- Implicit_Packing --
+         -----------------------
+
+         --  pragma Implicit_Packing;
+
+         when Pragma_Implicit_Packing =>
+            GNAT_Pragma;
+            Check_Arg_Count (0);
+            Implicit_Packing := True;
+
          ------------
          -- Import --
          ------------
@@ -7435,6 +7561,8 @@ package body Sem_Prag is
 
          --  pragma Java_Constructor ([Entity =>] LOCAL_NAME);
 
+         --  Also handles pragma CIL_Constructor
+
          when Pragma_CIL_Constructor | Pragma_Java_Constructor =>
          Java_Constructor : declare
             Id         : Entity_Id;
@@ -7660,7 +7788,7 @@ package body Sem_Prag is
                   --  differences in processing between Link_With
                   --  and Linker_Options).
 
-                  declare
+                  Arg_Store : declare
                      C : constant Char_Code := Get_Char_Code (' ');
                      S : constant String_Id :=
                            Strval (Expr_Value_S (Expression (Arg)));
@@ -7670,6 +7798,10 @@ package body Sem_Prag is
                      procedure Skip_Spaces;
                      --  Advance F past any spaces
 
+                     -----------------
+                     -- Skip_Spaces --
+                     -----------------
+
                      procedure Skip_Spaces is
                      begin
                         while F <= L and then Get_String_Char (S, F) = C loop
@@ -7677,6 +7809,8 @@ package body Sem_Prag is
                         end loop;
                      end Skip_Spaces;
 
+                  --  Start of processing for Arg_Store
+
                   begin
                      Skip_Spaces; -- skip leading spaces
 
@@ -7695,7 +7829,7 @@ package body Sem_Prag is
                            F := F + 1;
                         end if;
                      end loop;
-                  end;
+                  end Arg_Store;
 
                   Arg := Next (Arg);
 
@@ -7986,12 +8120,13 @@ package body Sem_Prag is
          -- Main --
          ----------
 
-         --  pragma Main_Storage
-         --   (MAIN_STORAGE_OPTION [, MAIN_STORAGE_OPTION]);
+         --  pragma Main
+         --   (MAIN_OPTION [, MAIN_OPTION]);
 
-         --  MAIN_STORAGE_OPTION ::=
-         --    [WORKING_STORAGE =>] static_SIMPLE_EXPRESSION
-         --  | [TOP_GUARD =>] static_SIMPLE_EXPRESSION
+         --  MAIN_OPTION ::=
+         --    [STACK_SIZE              =>] static_integer_EXPRESSION
+         --  | [TASK_STACK_SIZE_DEFAULT =>] static_integer_EXPRESSION
+         --  | [TIME_SLICING_ENABLED    =>] static_boolean_EXPRESSION
 
          when Pragma_Main => Main : declare
             Args  : Args_List (1 .. 3);
@@ -8507,7 +8642,7 @@ package body Sem_Prag is
                  or else Is_Atomic (Component_Type (Typ))
                then
                   Error_Pragma
-                       ("?pragma% ignored, cannot pack atomic components");
+                    ("?pragma% ignored, cannot pack atomic components");
                end if;
 
                --  If we had an explicit component size given, then we do not
@@ -8615,6 +8750,14 @@ package body Sem_Prag is
             end if;
 
             Set_Known_To_Have_Preelab_Init (Ent);
+
+            if Has_Pragma_Preelab_Init (Ent)
+              and then Warn_On_Redundant_Constructs
+            then
+               Error_Pragma ("?duplicate pragma%!");
+            else
+               Set_Has_Pragma_Preelab_Init (Ent);
+            end if;
          end Preelab_Init;
 
          -------------
@@ -8956,8 +9099,9 @@ package body Sem_Prag is
                   then
                      Error_Msg_Sloc :=
                        Specific_Dispatching.Table (J).Pragma_Loc;
-                     Error_Pragma ("priority range overlaps with" &
-                                   " Priority_Specific_Dispatching#");
+                        Error_Pragma
+                          ("priority range overlaps with "
+                           & "Priority_Specific_Dispatching#");
                   end if;
                end loop;
 
@@ -8966,8 +9110,9 @@ package body Sem_Prag is
 
                if Task_Dispatching_Policy /= ' ' then
                   Error_Msg_Sloc := Task_Dispatching_Policy_Sloc;
-                  Error_Pragma ("Priority_Specific_Dispatching incompatible" &
-                                " with Task_Dispatching_Policy#");
+                     Error_Pragma
+                       ("Priority_Specific_Dispatching incompatible "
+                        & "with Task_Dispatching_Policy#");
                end if;
 
                --  The use of Priority_Specific_Dispatching forces ceiling
@@ -8975,8 +9120,9 @@ package body Sem_Prag is
 
                if Locking_Policy /= ' ' and then Locking_Policy /= 'C' then
                   Error_Msg_Sloc := Locking_Policy_Sloc;
-                  Error_Pragma ("Priority_Specific_Dispatching incompatible" &
-                                " with Locking_Policy#");
+                     Error_Pragma
+                       ("Priority_Specific_Dispatching incompatible "
+                        & "with Locking_Policy#");
 
                --  Set the Ceiling_Locking policy, but preserve System_Location
                --  since we like the error message with the run time name.
@@ -9663,12 +9809,11 @@ package body Sem_Prag is
          -- Static_Elaboration_Desired --
          --------------------------------
 
-         --  Syntax ???
+         --  pragma Static_Elaboration_Desired (DIRECT_NAME);
 
          when Pragma_Static_Elaboration_Desired =>
-
-            --  GNAT_Pragma???
-            --  Check number of arguments ???
+            GNAT_Pragma;
+            Check_At_Most_N_Arguments (1);
 
             if Is_Compilation_Unit (Current_Scope)
               and then Ekind (Current_Scope) = E_Package
@@ -10362,7 +10507,6 @@ package body Sem_Prag is
                end if;
 
                Discr := First_Discriminant (Typ);
-
                while Present (Discr) loop
                   if No (Discriminant_Default_Value (Discr)) then
                      Error_Msg_N
@@ -10377,10 +10521,8 @@ package body Sem_Prag is
 
                Comp := First (Component_Items (Clist));
                while Present (Comp) loop
-
                   Check_Component (Comp);
                   Next (Comp);
-
                end loop;
 
                if No (Clist) or else No (Variant_Part (Clist)) then
@@ -10514,9 +10656,10 @@ package body Sem_Prag is
 
             if Is_In_Context_Clause then
 
-               --  The arguments must all be units mentioned in a with
-               --  clause in the same context clause. Note we already checked
-               --  (in Par.Prag) that the arguments are either identifiers or
+               --  The arguments must all be units mentioned in a with clause
+               --  in the same context clause. Note we already checked (in
+               --  Par.Prag) that the arguments are either identifiers or
+               --  selected components.
 
                Arg_Node := Arg1;
                while Present (Arg_Node) loop
@@ -10881,36 +11024,29 @@ package body Sem_Prag is
                         String_To_Name_Buffer
                           (Strval (Expr_Value_S (Expression (Arg2))));
 
-                        --  Configuration pragma case
-
-                        if Is_Configuration_Pragma then
-                           if Chars (Argx) = Name_On then
-                              Error_Pragma
-                                ("pragma Warnings (On, string) cannot be " &
-                                 "used as configuration pragma");
-
-                           else
-                              Set_Specific_Warning_Off
-                                (No_Location, Name_Buffer (1 .. Name_Len));
-                           end if;
-
-                        --  Normal (non-configuration pragma) case
-
-                        else
-                           if Chars (Argx) = Name_Off then
-                              Set_Specific_Warning_Off
-                                (Loc, Name_Buffer (1 .. Name_Len));
-
-                           elsif Chars (Argx) = Name_On then
-                              Set_Specific_Warning_On
-                                (Loc, Name_Buffer (1 .. Name_Len), Err);
-
-                              if Err then
-                                 Error_Msg
-                                   ("?pragma Warnings On with no " &
-                                    "matching Warnings Off",
-                                    Loc);
-                              end if;
+                        --  Note on configuration pragma case: If this is a
+                        --  configuration pragma, then for an OFF pragma, we
+                        --  just set Config True in the call, which is all
+                        --  that needs to be done. For the case of ON, this
+                        --  is normally an error, unless it is canceling the
+                        --  effect of a previous OFF pragma in the same file.
+                        --  In any other case, an error will be signalled (ON
+                        --  with no matching OFF).
+
+                        if Chars (Argx) = Name_Off then
+                           Set_Specific_Warning_Off
+                             (Loc, Name_Buffer (1 .. Name_Len),
+                              Config => Is_Configuration_Pragma);
+
+                        elsif Chars (Argx) = Name_On then
+                           Set_Specific_Warning_On
+                             (Loc, Name_Buffer (1 .. Name_Len), Err);
+
+                           if Err then
+                              Error_Msg
+                                ("?pragma Warnings On with no " &
+                                 "matching Warnings Off",
+                                 Loc);
                            end if;
                         end if;
                      end if;
@@ -11104,6 +11240,7 @@ package body Sem_Prag is
       Pragma_Atomic                        =>  0,
       Pragma_Atomic_Components             =>  0,
       Pragma_Attach_Handler                => -1,
+      Pragma_Check_Name                    =>  0,
       Pragma_CIL_Constructor               => -1,
       Pragma_CPP_Class                     =>  0,
       Pragma_CPP_Constructor               =>  0,
@@ -11114,6 +11251,7 @@ package body Sem_Prag is
       Pragma_Common_Object                 => -1,
       Pragma_Compile_Time_Error            => -1,
       Pragma_Compile_Time_Warning          => -1,
+      Pragma_Compiler_Unit                 =>  0,
       Pragma_Complete_Representation       =>  0,
       Pragma_Complex_Representation        =>  0,
       Pragma_Component_Alignment           => -1,
@@ -11143,6 +11281,7 @@ package body Sem_Prag is
       Pragma_Finalize_Storage_Only         =>  0,
       Pragma_Float_Representation          =>  0,
       Pragma_Ident                         => -1,
+      Pragma_Implicit_Packing              =>  0,
       Pragma_Import                        => +2,
       Pragma_Import_Exception              =>  0,
       Pragma_Import_Function               =>  0,