diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-14 08:39:55 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-14 08:39:55 +0000 |
commit | fbc67f84889a4d53b9c17f6a33368ee1f6f7a0e5 (patch) | |
tree | 7e41dee7f76f1b53282f8674e6481a3eda46f35d /gcc/ada/sem_prag.adb | |
parent | dbc3c2290abf6baf4182deb8549e0ae27f924a3d (diff) | |
download | gcc-fbc67f84889a4d53b9c17f6a33368ee1f6f7a0e5.tar.gz |
2007-08-14 Robert Dewar <dewar@adacore.com>
Ed Schonberg <schonberg@adacore.com>
* opt.ads: Warning for non-local exception propagation now off by
default
New switch -gnatI to disable representation clauses
Implement new pragma Implicit_Packing
* usage.adb:
Warning for non-local exception propagation now off by default
Add warning for unchecked conversion of pointers wi different
conventions.
New switch -gnatI to disable representation clauses
* usage.adb: new switch -gnatyS
* gnat_ugn.texi: For the gnatcheck Non_Qualified_Aggregates rule add a
note that aggregates of anonymous array types are not flagged.
-gnatwc now includes membership tests optimized away
-gnatw.x warnings are now off by default
Added conditional compilation Appendix
Add documentation of -gnatI
Add documentation for new -gnatyS style check
Update documentation about SAL and auto-init on Windows.
* gnat_rm.texi:
Add documentation for pragma Check_Name and 'Enabled attribute
Document that Eliminate on dispatching operation is ignored
Document IDE attributes VCS_Repository_Root and VCS_Patch_Root.
Document pragma Main
Document pragma Implicit_Packing
* sem_ch13.adb: Add warning for unchecked conversion of pointers wi
different conventions
New switch -gnatI to disable representation clauses
* switch-c.adb (Scan_Front_End_Switches): When a -gnat switch is not
recognized, report the invalid characters including "-gnat" instead of
just the first character in the switch.
New switch -gnatI to disable representation clauses
Set Warn_On_Object_Renames_Function true for -gnatg
* vms_data.ads: Add doc for /IGNORE_REP_CLAUSES
Add STATEMENTS_AFTER_THEN_ELSE as synonym for -gnatyS
Add qualifier /ADD_PROJECT_SEARCH_DIR= for different tools, equivalent
to switch -aP (add directory to project search dir).
* par-prag.adb: Implement new pragma Implicit_Packing
* sem_prag.adb (Analyze_Pragma, case Complex_Representation): Mark the
type as having a non-standard representation, to force expansion on
conversion to related types.
(Analyze_Pragma): Warn on misspelled pragma
(Analyze_Pragma, case Convention_Identifier): Fix checking of second arg
Ensure consistent use of # in error messages
Implement pragma Implicit_Packing
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127421 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sem_prag.adb')
-rw-r--r-- | gcc/ada/sem_prag.adb | 378 |
1 files changed, 252 insertions, 126 deletions
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 5f4b95d2ae6..e58cfc34808 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -32,6 +32,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 +2107,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 +2139,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 +2194,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 +2226,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 +2582,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 +2847,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 +2942,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 +2958,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 +3119,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 +3241,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 +3696,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); @@ -3974,18 +3971,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 +4012,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 +4033,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 +4044,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 +4089,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 +4275,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 +4518,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 +4617,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 +4648,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 +4699,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 +4764,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 +5237,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 -- ------------- @@ -5275,6 +5372,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; @@ -5435,7 +5539,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 +5954,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)) @@ -6388,7 +6491,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 @@ -6747,6 +6850,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 +7549,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 +7776,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 +7786,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 +7797,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 +7817,7 @@ package body Sem_Prag is F := F + 1; end if; end loop; - end; + end Arg_Store; Arg := Next (Arg); @@ -7986,12 +8108,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 +8630,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 +8738,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 +9087,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 +9098,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 +9108,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 +9797,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 +10495,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 +10509,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 +10644,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 +11012,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 +11228,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, @@ -11143,6 +11268,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, |