end if;
end Remove_Warning_Messages;
+ ----------------------
+ -- Adjust_Name_Case --
+ ----------------------
+
+ procedure Adjust_Name_Case (Loc : Source_Ptr) is
+ begin
+ -- We have an all lower case name from Namet, and now we want to set
+ -- the appropriate case. If possible we copy the actual casing from
+ -- the source. If not we use standard identifier casing.
+
+ declare
+ Src_Ind : constant Source_File_Index := Get_Source_File_Index (Loc);
+ Sbuffer : Source_Buffer_Ptr;
+ Ref_Ptr : Integer;
+ Src_Ptr : Source_Ptr;
+
+ begin
+ Ref_Ptr := 1;
+ Src_Ptr := Loc;
+
+ -- For standard locations, always use mixed case
+
+ if Loc <= No_Location then
+ Set_Casing (Mixed_Case);
+
+ else
+ -- Determine if the reference we are dealing with corresponds to
+ -- text at the point of the error reference. This will often be
+ -- the case for simple identifier references, and is the case
+ -- where we can copy the casing from the source.
+
+ Sbuffer := Source_Text (Src_Ind);
+
+ while Ref_Ptr <= Name_Len loop
+ exit when
+ Fold_Lower (Sbuffer (Src_Ptr)) /=
+ Fold_Lower (Name_Buffer (Ref_Ptr));
+ Ref_Ptr := Ref_Ptr + 1;
+ Src_Ptr := Src_Ptr + 1;
+ end loop;
+
+ -- If we get through the loop without a mismatch, then output the
+ -- name the way it is cased in the source program
+
+ if Ref_Ptr > Name_Len then
+ Src_Ptr := Loc;
+
+ for J in 1 .. Name_Len loop
+ Name_Buffer (J) := Sbuffer (Src_Ptr);
+ Src_Ptr := Src_Ptr + 1;
+ end loop;
+
+ -- Otherwise set the casing using the default identifier casing
+
+ else
+ Set_Casing (Identifier_Casing (Src_Ind), Mixed_Case);
+ end if;
+ end if;
+ end;
+ end Adjust_Name_Case;
+
---------------------------
-- Set_Identifier_Casing --
---------------------------
------------------
procedure Set_Msg_Node (Node : Node_Id) is
+ Loc : Source_Ptr;
Ent : Entity_Id;
Nam : Name_Id;
if Nkind (Node) = N_Pragma then
Nam := Pragma_Name (Node);
+ Loc := Sloc (Node);
-- The other cases have Chars fields, and we want to test for possible
-- internal names, which generally represent something gone wrong. An
Ent := Node;
end if;
+ Loc := Sloc (Ent);
+
-- If the type is the designated type of an access_to_subprogram,
-- then there is no name to provide in the call.
else
Nam := Chars (Node);
+ Loc := Sloc (Node);
end if;
-- At this stage, the name to output is in Nam
Get_Unqualified_Decoded_Name_String (Nam);
-- Remove trailing upper case letters from the name (useful for
- -- dealing with some cases of internal names.
+ -- dealing with some cases of internal names).
while Name_Len > 1 and then Name_Buffer (Name_Len) in 'A' .. 'Z' loop
Name_Len := Name_Len - 1;
Kill_Message := True;
end if;
- -- Now we have to set the proper case. If we have a source location
- -- then do a check to see if the name in the source is the same name
- -- as the name in the Names table, except for possible differences
- -- in case, which is the case when we can copy from the source.
-
- declare
- Src_Loc : constant Source_Ptr := Sloc (Node);
- Sbuffer : Source_Buffer_Ptr;
- Ref_Ptr : Integer;
- Src_Ptr : Source_Ptr;
-
- begin
- Ref_Ptr := 1;
- Src_Ptr := Src_Loc;
-
- -- For standard locations, always use mixed case
-
- if Src_Loc <= No_Location
- or else Sloc (Node) <= No_Location
- then
- Set_Casing (Mixed_Case);
-
- else
- -- Determine if the reference we are dealing with corresponds to
- -- text at the point of the error reference. This will often be
- -- the case for simple identifier references, and is the case
- -- where we can copy the spelling from the source.
-
- Sbuffer := Source_Text (Get_Source_File_Index (Src_Loc));
-
- while Ref_Ptr <= Name_Len loop
- exit when
- Fold_Lower (Sbuffer (Src_Ptr)) /=
- Fold_Lower (Name_Buffer (Ref_Ptr));
- Ref_Ptr := Ref_Ptr + 1;
- Src_Ptr := Src_Ptr + 1;
- end loop;
-
- -- If we get through the loop without a mismatch, then output the
- -- name the way it is spelled in the source program
-
- if Ref_Ptr > Name_Len then
- Src_Ptr := Src_Loc;
-
- for J in 1 .. Name_Len loop
- Name_Buffer (J) := Sbuffer (Src_Ptr);
- Src_Ptr := Src_Ptr + 1;
- end loop;
-
- -- Otherwise set the casing using the default identifier casing
-
- else
- Set_Casing (Identifier_Casing (Flag_Source), Mixed_Case);
- end if;
- end if;
- end;
+ -- Remaining step is to adjust casing and possibly add 'Class
+ Adjust_Name_Case (Loc);
Set_Msg_Name_Buffer;
Add_Class;
end Set_Msg_Node;
with Checks; use Checks;
with Einfo; use Einfo;
with Elists; use Elists;
+with Errout; use Errout;
with Expander; use Expander;
with Exp_Atag; use Exp_Atag;
with Exp_Ch4; use Exp_Ch4;
Ent := Current_Scope;
while Present (Ent) loop
- exit when Ekind (Ent) /= E_Block
- and then Ekind (Ent) /= E_Loop;
+ exit when not Ekind_In (Ent, E_Block, E_Loop);
Ent := Scope (Ent);
end loop;
Name_Buffer (Save_NL + 1 .. Save_NL + Name_Len) :=
Name_Buffer (1 .. Name_Len);
Name_Buffer (1 .. Save_NL) := Save_NB;
+ Name_Len := Name_Len + Save_NL;
end Add_Source_Info;
---------------------------------
-----------------------
procedure Write_Entity_Name (E : Entity_Id) is
- SDef : Source_Ptr;
- TDef : constant Source_Buffer_Ptr :=
- Source_Text (Get_Source_File_Index (Sloc (E)));
- begin
- -- Nothing to do if at outer level
+ procedure Write_Entity_Name_Inner (E : Entity_Id);
+ -- Inner recursive routine, keep outer routine non-recursive to ease
+ -- debugging when we get strange results from this routine.
- if Scope (E) = Standard_Standard then
- null;
+ -----------------------------
+ -- Write_Entity_Name_Inner --
+ -----------------------------
+
+ procedure Write_Entity_Name_Inner (E : Entity_Id) is
+ begin
+ -- If entity has an internal name, skip by it, and print its scope.
+ -- Note that Is_Internal_Name destroys Name_Buffer, hence the save
+ -- and restore since we depend on its current contents. Note that
+ -- we strip a final R from the name before the test, this is needed
+ -- for some cases of instantiations.
+
+ declare
+ Save_NB : constant String := Name_Buffer (1 .. Name_Len);
+ Save_NL : constant Natural := Name_Len;
+ Iname : Boolean;
+
+ begin
+ Get_Name_String (Chars (E));
+
+ if Name_Buffer (Name_Len) = 'R' then
+ Name_Len := Name_Len - 1;
+ end if;
+
+ Iname := Is_Internal_Name;
+
+ Name_Buffer (1 .. Save_NL) := Save_NB;
+ Name_Len := Save_NL;
+
+ if Iname then
+ Write_Entity_Name_Inner (Scope (E));
+ return;
+ end if;
+ end;
- -- If scope comes from source, write its name
+ -- Just print entity name if its scope is at the outer level
+
+ if Scope (E) = Standard_Standard then
+ null;
- elsif Comes_From_Source (Scope (E)) then
- Write_Entity_Name (Scope (E));
- Add_Char_To_Name_Buffer ('.');
+ -- If scope comes from source, write scope and entity
+
+ elsif Comes_From_Source (Scope (E)) then
+ Write_Entity_Name (Scope (E));
+ Add_Char_To_Name_Buffer ('.');
-- If in wrapper package skip past it
- elsif Is_Wrapper_Package (Scope (E)) then
- Write_Entity_Name (Scope (Scope (E)));
- Add_Char_To_Name_Buffer ('.');
+ elsif Is_Wrapper_Package (Scope (E)) then
+ Write_Entity_Name (Scope (Scope (E)));
+ Add_Char_To_Name_Buffer ('.');
-- Otherwise nothing to output (happens in unnamed block statements)
- else
- null;
- end if;
+ else
+ null;
+ end if;
- -- Output the name
+ -- Output the name
- SDef := Sloc (E);
+ declare
+ Save_NB : constant String := Name_Buffer (1 .. Name_Len);
+ Save_NL : constant Natural := Name_Len;
- -- Check for operator name in quotes
+ begin
+ Get_Unqualified_Decoded_Name_String (Chars (E));
- if TDef (SDef) = '"' then
- Add_Char_To_Name_Buffer ('"');
+ -- Remove trailing upper case letters from the name (useful for
+ -- dealing with some cases of internal names generated in the case
+ -- of references from within a generic.
- -- Loop to output characters of operator name and terminating quote
+ while Name_Len > 1
+ and then Name_Buffer (Name_Len) in 'A' .. 'Z'
+ loop
+ Name_Len := Name_Len - 1;
+ end loop;
- loop
- SDef := SDef + 1;
- Add_Char_To_Name_Buffer (TDef (SDef));
- exit when TDef (SDef) = '"';
- end loop;
+ -- Adjust casing appropriately (gets name from source if possible)
- -- Normal case of identifier
+ Adjust_Name_Case (Sloc (E));
- else
- -- Loop to output the name
+ -- Append to original entry value of Name_Buffer
- -- This is not right wrt wide char encodings ??? ()
+ Name_Buffer (Save_NL + 1 .. Save_NL + Name_Len) :=
+ Name_Buffer (1 .. Name_Len);
+ Name_Buffer (1 .. Save_NL) := Save_NB;
+ Name_Len := Save_NL + Name_Len;
+ end;
+ end Write_Entity_Name_Inner;
- while TDef (SDef) in '0' .. '9'
- or else TDef (SDef) >= 'A'
- or else TDef (SDef) = ASCII.ESC
- loop
- Add_Char_To_Name_Buffer (TDef (SDef));
- SDef := SDef + 1;
- end loop;
- end if;
+ -- Start of processing for Write_Entity_Name
+
+ begin
+ Write_Entity_Name_Inner (E);
end Write_Entity_Name;
end Exp_Intr;
-- 0 indicates that appearance in any argument is not significant
-- +n indicates that appearance as argument n is significant, but all
-- other arguments are not significant
- -- 99 special processing required (e.g. for pragma Check)
+ -- 9n arguments from n on are significant, before n inisignificant
Sig_Flags : constant array (Pragma_Id) of Int :=
(Pragma_Abort_Defer => -1,
Pragma_Ada_12 => -1,
Pragma_Ada_2012 => -1,
Pragma_All_Calls_Remote => -1,
- Pragma_Allow_Integer_Address => 0,
- Pragma_Annotate => -1,
+ Pragma_Allow_Integer_Address => -1,
+ Pragma_Annotate => 93,
Pragma_Assert => -1,
Pragma_Assert_And_Cut => -1,
Pragma_Assertion_Policy => 0,
Pragma_Assume_No_Invalid_Values => 0,
Pragma_Async_Readers => 0,
Pragma_Async_Writers => 0,
- Pragma_Asynchronous => -1,
+ Pragma_Asynchronous => 0,
Pragma_Atomic => 0,
Pragma_Atomic_Components => 0,
Pragma_Attach_Handler => -1,
- Pragma_Attribute_Definition => +3,
- Pragma_Check => 99,
+ Pragma_Attribute_Definition => 92,
+ Pragma_Check => -1,
Pragma_Check_Float_Overflow => 0,
Pragma_Check_Name => 0,
Pragma_Check_Policy => 0,
- Pragma_CIL_Constructor => -1,
+ Pragma_CIL_Constructor => 0,
Pragma_CPP_Class => 0,
Pragma_CPP_Constructor => 0,
Pragma_CPP_Virtual => 0,
Pragma_CPP_Vtable => 0,
Pragma_CPU => -1,
Pragma_C_Pass_By_Copy => 0,
- Pragma_Comment => 0,
- Pragma_Common_Object => -1,
+ Pragma_Comment => -1,
+ Pragma_Common_Object => 0,
Pragma_Compile_Time_Error => -1,
Pragma_Compile_Time_Warning => -1,
- Pragma_Compiler_Unit => 0,
- Pragma_Compiler_Unit_Warning => 0,
+ Pragma_Compiler_Unit => -1,
+ Pragma_Compiler_Unit_Warning => -1,
Pragma_Complete_Representation => 0,
Pragma_Complex_Representation => 0,
- Pragma_Component_Alignment => -1,
+ Pragma_Component_Alignment => 0,
Pragma_Contract_Cases => -1,
Pragma_Controlled => 0,
Pragma_Convention => 0,
Pragma_Convention_Identifier => 0,
Pragma_Debug => -1,
Pragma_Debug_Policy => 0,
- Pragma_Detect_Blocking => -1,
+ Pragma_Detect_Blocking => 0,
Pragma_Default_Initial_Condition => -1,
Pragma_Default_Scalar_Storage_Order => 0,
- Pragma_Default_Storage_Pool => -1,
+ Pragma_Default_Storage_Pool => 0,
Pragma_Depends => -1,
- Pragma_Disable_Atomic_Synchronization => -1,
+ Pragma_Disable_Atomic_Synchronization => 0,
Pragma_Discard_Names => 0,
Pragma_Dispatching_Domain => -1,
Pragma_Effective_Reads => 0,
Pragma_Effective_Writes => 0,
- Pragma_Elaborate => -1,
- Pragma_Elaborate_All => -1,
- Pragma_Elaborate_Body => -1,
- Pragma_Elaboration_Checks => -1,
- Pragma_Eliminate => -1,
- Pragma_Enable_Atomic_Synchronization => -1,
+ Pragma_Elaborate => 0,
+ Pragma_Elaborate_All => 0,
+ Pragma_Elaborate_Body => 0,
+ Pragma_Elaboration_Checks => 0,
+ Pragma_Eliminate => 0,
+ Pragma_Enable_Atomic_Synchronization => 0,
Pragma_Export => -1,
Pragma_Export_Function => -1,
Pragma_Export_Object => -1,
Pragma_Export_Value => -1,
Pragma_Export_Valued_Procedure => -1,
Pragma_Extend_System => -1,
- Pragma_Extensions_Allowed => -1,
+ Pragma_Extensions_Allowed => 0,
Pragma_External => -1,
- Pragma_Favor_Top_Level => -1,
- Pragma_External_Name_Casing => -1,
- Pragma_Fast_Math => -1,
+ Pragma_Favor_Top_Level => 0,
+ Pragma_External_Name_Casing => 0,
+ Pragma_Fast_Math => 0,
Pragma_Finalize_Storage_Only => 0,
Pragma_Global => -1,
Pragma_Ident => -1,
Pragma_Implementation_Defined => -1,
Pragma_Implemented => -1,
Pragma_Implicit_Packing => 0,
- Pragma_Import => +2,
+ Pragma_Import => 93,
Pragma_Import_Function => 0,
Pragma_Import_Object => 0,
Pragma_Import_Procedure => 0,
Pragma_Independent => 0,
Pragma_Independent_Components => 0,
Pragma_Initial_Condition => -1,
- Pragma_Initialize_Scalars => -1,
+ Pragma_Initialize_Scalars => 0,
Pragma_Initializes => -1,
Pragma_Inline => 0,
Pragma_Inline_Always => 0,
Pragma_Inline_Generic => 0,
Pragma_Inspection_Point => -1,
- Pragma_Interface => +2,
- Pragma_Interface_Name => +2,
+ Pragma_Interface => 92,
+ Pragma_Interface_Name => 0,
Pragma_Interrupt_Handler => -1,
Pragma_Interrupt_Priority => -1,
Pragma_Interrupt_State => -1,
Pragma_Java_Constructor => -1,
Pragma_Java_Interface => -1,
Pragma_Keep_Names => 0,
- Pragma_License => -1,
+ Pragma_License => 0,
Pragma_Link_With => -1,
Pragma_Linker_Alias => -1,
Pragma_Linker_Constructor => -1,
Pragma_Linker_Destructor => -1,
Pragma_Linker_Options => -1,
- Pragma_Linker_Section => -1,
- Pragma_List => -1,
- Pragma_Lock_Free => -1,
- Pragma_Locking_Policy => -1,
+ Pragma_Linker_Section => 0,
+ Pragma_List => 0,
+ Pragma_Lock_Free => 0,
+ Pragma_Locking_Policy => 0,
Pragma_Loop_Invariant => -1,
- Pragma_Loop_Optimize => -1,
+ Pragma_Loop_Optimize => 0,
Pragma_Loop_Variant => -1,
Pragma_Machine_Attribute => -1,
Pragma_Main => -1,
Pragma_Main_Storage => -1,
- Pragma_Memory_Size => -1,
+ Pragma_Memory_Size => 0,
Pragma_No_Return => 0,
Pragma_No_Body => 0,
- Pragma_No_Elaboration_Code_All => -1,
+ Pragma_No_Elaboration_Code_All => 0,
Pragma_No_Inline => 0,
Pragma_No_Run_Time => -1,
Pragma_No_Strict_Aliasing => -1,
- Pragma_Normalize_Scalars => -1,
+ Pragma_Normalize_Scalars => 0,
Pragma_Obsolescent => 0,
- Pragma_Optimize => -1,
- Pragma_Optimize_Alignment => -1,
+ Pragma_Optimize => 0,
+ Pragma_Optimize_Alignment => 0,
Pragma_Overflow_Mode => 0,
Pragma_Overriding_Renamings => 0,
- Pragma_Ordered => -1,
+ Pragma_Ordered => 0,
Pragma_Pack => 0,
- Pragma_Page => -1,
- Pragma_Part_Of => -1,
- Pragma_Partition_Elaboration_Policy => -1,
- Pragma_Passive => -1,
+ Pragma_Page => 0,
+ Pragma_Part_Of => 0,
+ Pragma_Partition_Elaboration_Policy => 0,
+ Pragma_Passive => 0,
Pragma_Persistent_BSS => 0,
Pragma_Polling => 0,
Pragma_Prefix_Exception_Messages => 0,
Pragma_Precondition => -1,
Pragma_Predicate => -1,
Pragma_Preelaborable_Initialization => -1,
- Pragma_Preelaborate => -1,
+ Pragma_Preelaborate => 0,
Pragma_Pre_Class => -1,
Pragma_Priority => -1,
- Pragma_Priority_Specific_Dispatching => -1,
+ Pragma_Priority_Specific_Dispatching => 0,
Pragma_Profile => 0,
Pragma_Profile_Warnings => 0,
- Pragma_Propagate_Exceptions => -1,
- Pragma_Provide_Shift_Operators => -1,
- Pragma_Psect_Object => -1,
- Pragma_Pure => -1,
- Pragma_Pure_Function => -1,
- Pragma_Queuing_Policy => -1,
- Pragma_Rational => -1,
- Pragma_Ravenscar => -1,
+ Pragma_Propagate_Exceptions => 0,
+ Pragma_Provide_Shift_Operators => 0,
+ Pragma_Psect_Object => 0,
+ Pragma_Pure => 0,
+ Pragma_Pure_Function => 0,
+ Pragma_Queuing_Policy => 0,
+ Pragma_Rational => 0,
+ Pragma_Ravenscar => 0,
Pragma_Refined_Depends => -1,
Pragma_Refined_Global => -1,
Pragma_Refined_Post => -1,
Pragma_Refined_State => -1,
- Pragma_Relative_Deadline => -1,
+ Pragma_Relative_Deadline => 0,
Pragma_Remote_Access_Type => -1,
Pragma_Remote_Call_Interface => -1,
Pragma_Remote_Types => -1,
- Pragma_Restricted_Run_Time => -1,
- Pragma_Restriction_Warnings => -1,
- Pragma_Restrictions => -1,
+ Pragma_Restricted_Run_Time => 0,
+ Pragma_Restriction_Warnings => 0,
+ Pragma_Restrictions => 0,
Pragma_Reviewable => -1,
- Pragma_Short_Circuit_And_Or => -1,
- Pragma_Share_Generic => -1,
- Pragma_Shared => -1,
- Pragma_Shared_Passive => -1,
+ Pragma_Short_Circuit_And_Or => 0,
+ Pragma_Share_Generic => 0,
+ Pragma_Shared => 0,
+ Pragma_Shared_Passive => 0,
Pragma_Short_Descriptors => 0,
Pragma_Simple_Storage_Pool_Type => 0,
- Pragma_Source_File_Name => -1,
- Pragma_Source_File_Name_Project => -1,
- Pragma_Source_Reference => -1,
+ Pragma_Source_File_Name => 0,
+ Pragma_Source_File_Name_Project => 0,
+ Pragma_Source_Reference => 0,
Pragma_SPARK_Mode => 0,
Pragma_Storage_Size => -1,
- Pragma_Storage_Unit => -1,
- Pragma_Static_Elaboration_Desired => -1,
- Pragma_Stream_Convert => -1,
- Pragma_Style_Checks => -1,
- Pragma_Subtitle => -1,
+ Pragma_Storage_Unit => 0,
+ Pragma_Static_Elaboration_Desired => 0,
+ Pragma_Stream_Convert => 0,
+ Pragma_Style_Checks => 0,
+ Pragma_Subtitle => 0,
Pragma_Suppress => 0,
Pragma_Suppress_Exception_Locations => 0,
- Pragma_Suppress_All => -1,
+ Pragma_Suppress_All => 0,
Pragma_Suppress_Debug_Info => 0,
Pragma_Suppress_Initialization => 0,
- Pragma_System_Name => -1,
- Pragma_Task_Dispatching_Policy => -1,
+ Pragma_System_Name => 0,
+ Pragma_Task_Dispatching_Policy => 0,
Pragma_Task_Info => -1,
Pragma_Task_Name => -1,
- Pragma_Task_Storage => 0,
+ Pragma_Task_Storage => -1,
Pragma_Test_Case => -1,
- Pragma_Thread_Local_Storage => 0,
+ Pragma_Thread_Local_Storage => -1,
Pragma_Time_Slice => -1,
- Pragma_Title => -1,
+ Pragma_Title => 0,
Pragma_Type_Invariant => -1,
Pragma_Type_Invariant_Class => -1,
Pragma_Unchecked_Union => 0,
- Pragma_Unimplemented_Unit => -1,
- Pragma_Universal_Aliasing => -1,
- Pragma_Universal_Data => -1,
- Pragma_Unmodified => -1,
- Pragma_Unreferenced => -1,
- Pragma_Unreferenced_Objects => -1,
- Pragma_Unreserve_All_Interrupts => -1,
+ Pragma_Unimplemented_Unit => 0,
+ Pragma_Universal_Aliasing => 0,
+ Pragma_Universal_Data => 0,
+ Pragma_Unmodified => 0,
+ Pragma_Unreferenced => 0,
+ Pragma_Unreferenced_Objects => 0,
+ Pragma_Unreserve_All_Interrupts => 0,
Pragma_Unsuppress => 0,
Pragma_Unevaluated_Use_Of_Old => 0,
- Pragma_Use_VADS_Size => -1,
- Pragma_Validity_Checks => -1,
+ Pragma_Use_VADS_Size => 0,
+ Pragma_Validity_Checks => 0,
Pragma_Volatile => 0,
Pragma_Volatile_Components => 0,
- Pragma_Warning_As_Error => -1,
- Pragma_Warnings => -1,
- Pragma_Weak_External => -1,
+ Pragma_Warning_As_Error => 0,
+ Pragma_Warnings => 0,
+ Pragma_Weak_External => 0,
Pragma_Wide_Character_Encoding => 0,
Unknown_Pragma => 0);
Id : Pragma_Id;
P : Node_Id;
C : Int;
- A : Node_Id;
+ AN : Nat;
+
+ function Arg_No return Nat;
+ -- Returns an integer showing what argument we are in. A value of
+ -- zero means we are not in any of the arguments.
+
+ ------------
+ -- Arg_No --
+ ------------
+
+ function Arg_No return Nat is
+ A : Node_Id;
+ N : Nat;
+
+ begin
+ A := First (Pragma_Argument_Associations (Parent (P)));
+ N := 1;
+ loop
+ if No (A) then
+ return 0;
+ elsif A = P then
+ return N;
+ end if;
+
+ Next (A);
+ N := N + 1;
+ end loop;
+ end Arg_No;
+
+ -- Start of processing for Non_Significant_Pragma_Reference
begin
P := Parent (N);
else
Id := Get_Pragma_Id (Parent (P));
C := Sig_Flags (Id);
+ AN := Arg_No;
+
+ if AN = 0 then
+ return False;
+ end if;
case C is
when -1 =>
when 0 =>
return True;
- when 99 =>
- case Id is
-
- -- For pragma Check, the first argument is not significant,
- -- the second and the third (if present) arguments are
- -- significant.
-
- when Pragma_Check =>
- return
- P = First (Pragma_Argument_Associations (Parent (P)));
-
- when others =>
- raise Program_Error;
- end case;
+ when 92 .. 99 =>
+ return AN < (C - 90);
when others =>
- A := First (Pragma_Argument_Associations (Parent (P)));
- for J in 1 .. C - 1 loop
- if No (A) then
- return False;
- end if;
-
- Next (A);
- end loop;
-
- return A = P; -- is this wrong way round ???
+ return AN /= C;
end case;
end if;
end Is_Non_Significant_Pragma_Reference;
projects / gcc.git / commitdiff