diff options
Diffstat (limited to 'gcc/ada/bcheck.adb')
| -rw-r--r-- | gcc/ada/bcheck.adb | 269 |
1 files changed, 128 insertions, 141 deletions
diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index fd55b9144c7..ff534ba8d13 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2004 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- -- @@ -51,8 +51,8 @@ package body Bcheck is procedure Check_Consistent_Interrupt_States; procedure Check_Consistent_Locking_Policy; procedure Check_Consistent_Normalize_Scalars; - procedure Check_Consistent_Partition_Restrictions; procedure Check_Consistent_Queuing_Policy; + procedure Check_Consistent_Restrictions; procedure Check_Consistent_Zero_Cost_Exception_Handling; procedure Consistency_Error_Msg (Msg : String); @@ -84,7 +84,7 @@ package body Bcheck is Check_Consistent_Normalize_Scalars; Check_Consistent_Dynamic_Elaboration_Checking; - Check_Consistent_Partition_Restrictions; + Check_Consistent_Restrictions; Check_Consistent_Interrupt_States; end Check_Configuration_Consistency; @@ -362,184 +362,171 @@ package body Bcheck is end if; end Check_Consistent_Normalize_Scalars; - --------------------------------------------- - -- Check_Consistent_Partition_Restrictions -- - --------------------------------------------- - - -- The rule is that if a restriction is specified in any unit, - -- then all units must obey the restriction. The check applies - -- only to restrictions which require partition wide consistency, - -- and not to internal units. - - -- The check is done in two steps. First for every restriction - -- a unit specifying that restriction is found, if any. - -- Second, all units are verified against the specified restrictions. - - procedure Check_Consistent_Partition_Restrictions is - No_Restriction_List : constant array (All_Restrictions) of Boolean := - (No_Implicit_Conditionals => True, - -- This could modify and pessimize generated code - - No_Implicit_Dynamic_Code => True, - -- This could modify and pessimize generated code - - No_Implicit_Loops => True, - -- This could modify and pessimize generated code + ------------------------------------- + -- Check_Consistent_Queuing_Policy -- + ------------------------------------- - No_Recursion => True, - -- Not checkable at compile time + -- The rule is that all files for which the queuing policy is + -- significant must be compiled with the same setting. - No_Reentrancy => True, - -- Not checkable at compile time + procedure Check_Consistent_Queuing_Policy is + begin + -- First search for a unit specifying a policy and then + -- check all remaining units against it. - others => False); - -- Define those restrictions that should be output if the gnatbind -r - -- switch is used. Not all restrictions are output for the reasons given - -- above in the list, and this array is used to test whether the - -- corresponding pragma should be listed. True means that it should not - -- be listed. + Find_Policy : for A1 in ALIs.First .. ALIs.Last loop + if ALIs.Table (A1).Queuing_Policy /= ' ' then + Check_Policy : declare + Policy : constant Character := ALIs.Table (A1).Queuing_Policy; + begin + for A2 in A1 + 1 .. ALIs.Last loop + if ALIs.Table (A2).Queuing_Policy /= ' ' + and then + ALIs.Table (A2).Queuing_Policy /= Policy + then + Error_Msg_Name_1 := ALIs.Table (A1).Sfile; + Error_Msg_Name_2 := ALIs.Table (A2).Sfile; - R : array (All_Restrictions) of ALI_Id := (others => No_ALI_Id); - -- Record the first unit specifying each compilation unit restriction + Consistency_Error_Msg + ("% and % compiled with different queuing policies"); + exit Find_Policy; + end if; + end loop; + end Check_Policy; - V : array (All_Restrictions) of ALI_Id := (others => No_ALI_Id); - -- Record the last unit violating each partition restriction. Note - -- that entries in this array that do not correspond to partition - -- restrictions can never be modified. + exit Find_Policy; + end if; + end loop Find_Policy; + end Check_Consistent_Queuing_Policy; - Additional_Restrictions_Listed : Boolean := False; - -- Set True if we have listed header for restrictions + ----------------------------------- + -- Check_Consistent_Restrictions -- + ----------------------------------- - begin - -- Loop to find restrictions + -- The rule is that if a restriction is specified in any unit, + -- then all units must obey the restriction. The check applies + -- only to restrictions which require partition wide consistency, + -- and not to internal units. - for A in ALIs.First .. ALIs.Last loop - for J in All_Restrictions loop - if R (J) = No_ALI_Id and ALIs.Table (A).Restrictions (J) = 'r' then - R (J) := A; - end if; - end loop; - end loop; + procedure Check_Consistent_Restrictions is + Restriction_File_Output : Boolean; + -- Shows if we have output header messages for restriction violation - -- Loop to find violations + procedure Print_Restriction_File (R : All_Restrictions); + -- Print header line for R if not printed yet - for A in ALIs.First .. ALIs.Last loop - for J in All_Restrictions loop - if ALIs.Table (A).Restrictions (J) = 'v' - and then not Is_Internal_File_Name (ALIs.Table (A).Sfile) - then - -- A violation of a restriction was found + ---------------------------- + -- Print_Restriction_File -- + ---------------------------- - V (J) := A; + procedure Print_Restriction_File (R : All_Restrictions) is + begin + if not Restriction_File_Output then + Restriction_File_Output := True; - -- If this is a paritition restriction, and the restriction - -- was specified in some unit in the partition, then this - -- is a violation of the consistency requirement, so we - -- generate an appropriate error message. + -- Find the ali file specifying the restriction - if R (J) /= No_ALI_Id - and then J in Partition_Restrictions + for A in ALIs.First .. ALIs.Last loop + if ALIs.Table (A).Restrictions.Set (R) + and then (R in All_Boolean_Restrictions + or else ALIs.Table (A).Restrictions.Value (R) = + Cumulative_Restrictions.Value (R)) then + -- We have found that ALI file A specifies the restriction + -- that is being violated (the minimum value is specified + -- in the case of a parameter restriction). + declare - M1 : constant String := "% has Restriction ("; - S : constant String := Restriction_Id'Image (J); - M2 : String (1 .. M1'Length + S'Length + 1); + M1 : constant String := "% has restriction "; + S : constant String := Restriction_Id'Image (R); + M2 : String (1 .. 200); -- big enough! + P : Integer; begin Name_Buffer (1 .. S'Length) := S; Name_Len := S'Length; - Set_Casing - (Units.Table (ALIs.Table (R (J)).First_Unit).Icasing); + Set_Casing (Mixed_Case); M2 (M1'Range) := M1; - M2 (M1'Length + 1 .. M2'Last - 1) := - Name_Buffer (1 .. S'Length); - M2 (M2'Last) := ')'; + P := M1'Length + 1; + M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length); + P := P + S'Length; + + if R in All_Parameter_Restrictions then + M2 (P .. P + 4) := " => #"; + Error_Msg_Nat_1 := + Int (Cumulative_Restrictions.Value (R)); + P := P + 5; + end if; - Error_Msg_Name_1 := ALIs.Table (R (J)).Sfile; - Consistency_Error_Msg (M2); Error_Msg_Name_1 := ALIs.Table (A).Sfile; + Consistency_Error_Msg (M2 (1 .. P - 1)); Consistency_Error_Msg - ("but file % violates this restriction"); + ("but the following files violate this restriction:"); end; end if; - end if; - end loop; - end loop; + end loop; + end if; + end Print_Restriction_File; - -- List applicable restrictions if option set + -- Start of processing for Check_Consistent_Restrictions - if List_Restrictions then + begin + -- Loop through all restriction violations - -- List any restrictions which were not violated and not specified + for R in All_Restrictions loop - for J in All_Restrictions loop - if V (J) = No_ALI_Id - and then R (J) = No_ALI_Id - and then not No_Restriction_List (J) - then - if not Additional_Restrictions_Listed then - Write_Eol; - Write_Line - ("The following additional restrictions may be" & - " applied to this partition:"); - Additional_Restrictions_Listed := True; - end if; + -- Check for violation of this restriction - Write_Str ("pragma Restrictions ("); + if Cumulative_Restrictions.Set (R) + and then Cumulative_Restrictions.Violated (R) + and then (R in Partition_Boolean_Restrictions + or else (R in All_Parameter_Restrictions + and then + Cumulative_Restrictions.Count (R) > + Cumulative_Restrictions.Value (R))) + then + Restriction_File_Output := False; - declare - S : constant String := Restriction_Id'Image (J); - begin - Name_Len := S'Length; - Name_Buffer (1 .. Name_Len) := S; - end; + -- Loop through files looking for violators - Set_Casing (Mixed_Case); - Write_Str (Name_Buffer (1 .. Name_Len)); - Write_Str (");"); - Write_Eol; - end if; - end loop; - end if; - end Check_Consistent_Partition_Restrictions; + for A2 in ALIs.First .. ALIs.Last loop + if ALIs.Table (A2).Restrictions.Violated (R) then - ------------------------------------- - -- Check_Consistent_Queuing_Policy -- - ------------------------------------- + -- We exclude predefined files from the list of + -- violators. This should be rethought. It is not + -- clear that this is the right thing to do, that + -- is particularly the case for restricted runtimes. - -- The rule is that all files for which the queuing policy is - -- significant must be compiled with the same setting. + if not Is_Internal_File_Name (ALIs.Table (A2).Sfile) then + Print_Restriction_File (R); - procedure Check_Consistent_Queuing_Policy is - begin - -- First search for a unit specifying a policy and then - -- check all remaining units against it. + Error_Msg_Name_1 := ALIs.Table (A2).Sfile; - Find_Policy : for A1 in ALIs.First .. ALIs.Last loop - if ALIs.Table (A1).Queuing_Policy /= ' ' then - Check_Policy : declare - Policy : constant Character := ALIs.Table (A1).Queuing_Policy; - begin - for A2 in A1 + 1 .. ALIs.Last loop - if ALIs.Table (A2).Queuing_Policy /= ' ' - and then - ALIs.Table (A2).Queuing_Policy /= Policy - then - Error_Msg_Name_1 := ALIs.Table (A1).Sfile; - Error_Msg_Name_2 := ALIs.Table (A2).Sfile; + if R in All_Boolean_Restrictions then + Consistency_Error_Msg (" %"); - Consistency_Error_Msg - ("% and % compiled with different queuing policies"); - exit Find_Policy; - end if; - end loop; - end Check_Policy; + elsif R in Checked_Add_Parameter_Restrictions + or else ALIs.Table (A2).Restrictions.Count (R) > + Cumulative_Restrictions.Value (R) + then + Error_Msg_Nat_1 := + Int (ALIs.Table (A2).Restrictions.Count (R)); - exit Find_Policy; + if ALIs.Table (A2).Restrictions.Unknown (R) then + Consistency_Error_Msg + (" % (count = at least #)"); + else + Consistency_Error_Msg + (" % (count = #)"); + end if; + end if; + end if; + end if; + end loop; end if; - end loop Find_Policy; - end Check_Consistent_Queuing_Policy; + end loop; + end Check_Consistent_Restrictions; --------------------------------------------------- -- Check_Consistent_Zero_Cost_Exception_Handling -- |