diff options
Diffstat (limited to 'gcc/ada/sem_prag.adb')
| -rw-r--r-- | gcc/ada/sem_prag.adb | 71 |
1 files changed, 55 insertions, 16 deletions
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 28c5f17..0dc2e4f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10699,6 +10699,9 @@ package body Sem_Prag is -- the External_Name). For exceptions, the External_Name is the -- name of the RTTI structure. + -- Do not call Set_Is_Imported as that would disable the output + -- of the needed exception data structures. + -- ??? Emit an error if pragma Import/Export_Exception is present elsif Nkind (Parent (Def_Id)) = N_Incomplete_Type_Declaration then @@ -12690,7 +12693,8 @@ package body Sem_Prag is -- Pragma Unsigned_Base_Range temporarily disabled if not Is_Pragma_Name (Pname) - or else Pname = Name_Unsigned_Base_Range + or else (Pname = Name_Unsigned_Base_Range + and then not Debug_Flag_Dot_U) then declare Msg_Issued : Boolean := False; @@ -21867,8 +21871,17 @@ package body Sem_Prag is if Rep_Item_Too_Late (Def_Id, N) then return; - else - Set_Has_Gigi_Rep_Item (Def_Id); + end if; + + Set_Has_Gigi_Rep_Item (Def_Id); + + -- The pragma is processed directly by the back end when Def_Id is + -- translated. If the argument is not a string literal, it may be + -- declared after Def_Id and before the pragma, which requires the + -- processing of Def_Id to be delayed for the back end. + + if Nkind (Get_Pragma_Arg (Arg2)) /= N_String_Literal then + Set_Has_Delayed_Freeze (Def_Id); end if; end Machine_Attribute; @@ -28145,12 +28158,23 @@ package body Sem_Prag is then Error_Pragma_Arg ("cannot apply pragma %", - "\& is not a signed integer type", - Arg1); + "\& is not a signed integer type", Arg1); elsif Is_Derived_Type (E) then Error_Pragma_Arg ("pragma % cannot apply to derived type", Arg1); + + elsif Is_Generic_Type (E) then + Error_Pragma_Arg + ("pragma % cannot apply to formal type", Arg1); + + elsif Present (Expr) + and then Is_False (Expr_Value (Expr)) + and then Ekind (Base_Type (E)) = E_Modular_Integer_Type + and then Has_Unsigned_Base_Range_Aspect (Base_Type (E)) + then + Error_Pragma_Arg + ("pragma % can only confirm previous True value", Arg1); end if; Check_First_Subtype (Arg1); @@ -28158,17 +28182,19 @@ package body Sem_Prag is -- Create the new unsigned integer base type entity, and apply -- the constraint to create the first subtype of E. - Unsigned_Base_Range_Type_Declaration (E, - Def => Type_Definition (Parent (E))); + if No (Expr) or else Is_True (Expr_Value (Expr)) then + Unsigned_Base_Range_Type_Declaration (E, + Def => Type_Definition (Parent (E))); - Set_Direct_Primitive_Operations (Base_Type (E), New_Elmt_List); - Set_Direct_Primitive_Operations (E, - Direct_Primitive_Operations (Base_Type (E))); - Ensure_Freeze_Node (Base_Type (E)); - Set_First_Subtype_Link (Freeze_Node (Base_Type (E)), E); - Set_Has_Delayed_Freeze (E); + Set_Direct_Primitive_Operations (Base_Type (E), New_Elmt_List); + Set_Direct_Primitive_Operations (E, + Direct_Primitive_Operations (Base_Type (E))); + Ensure_Freeze_Node (Base_Type (E)); + Set_First_Subtype_Link (Freeze_Node (Base_Type (E)), E); + Set_Has_Delayed_Freeze (E); - Set_Has_Unsigned_Base_Range_Aspect (Base_Type (E)); + Set_Has_Unsigned_Base_Range_Aspect (Base_Type (E)); + end if; end Unsigned_Base_Range; ---------------- @@ -28761,6 +28787,17 @@ package body Sem_Prag is OK : Boolean; Chr : Character; + function Enclose_Ending_Space + (Raw_Str : String) return String + is (if Raw_Str (Raw_Str'Last) = ' ' + then '"' & Raw_Str & '"' + else Raw_Str); + function Enclose_Ending_Space + (Raw_Chr : Character) return String + is (Enclose_Ending_Space ((1 => Raw_Chr))); + -- This function ensures that no error message ends + -- with a space, in case we enclose it within quotes. + begin J := 1; while J <= Len loop @@ -28792,7 +28829,8 @@ package body Sem_Prag is if not Set_Warning_Switch ('.', Chr) then Error_Pragma_Arg ("invalid warning switch character " - & '.' & Chr, Arg1); + & Enclose_Ending_Space ('.' & Chr), + Arg1); end if; -- Non-Dot case @@ -28803,7 +28841,8 @@ package body Sem_Prag is if not OK then Error_Pragma_Arg - ("invalid warning switch character " & Chr, + ("invalid warning switch character " + & Enclose_Ending_Space (Chr), Arg1); end if; |