From: Arnaud Charlet Date: Mon, 23 Jan 2017 11:17:23 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=64a4f612f932d54d242f9c0f6594a84c2f764fcc;p=gcc.git [multiple changes] 2017-01-23 Hristian Kirtchev * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra spaces from error messages. 2017-01-23 Ed Schonberg * exp_ch3.adb (Check_Large_Modular_Array): New procedure, subsidiary to Expand_N_Object_ Declaration, to compute a guard on an object declaration for an array type with a modular index type with the size of Long_Long_Integer. Special processing is needed in this case to compute reliably the size of the object, and eventually to raise Storage_Error, when wrap-around arithmetic might compute a meangingless size for the object. 2017-01-23 Justin Squirek * a-wtenau.adb, par-endh.adb, sem_prag.adb, sem_type.adb: Code cleanups. From-SVN: r244775 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e482e850f7e..76ee520f0b4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-01-23 Hristian Kirtchev + + * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra + spaces from error messages. + +2017-01-23 Ed Schonberg + + * exp_ch3.adb (Check_Large_Modular_Array): New procedure, + subsidiary to Expand_N_Object_ Declaration, to compute a guard on + an object declaration for an array type with a modular index type + with the size of Long_Long_Integer. Special processing is needed + in this case to compute reliably the size of the object, and + eventually to raise Storage_Error, when wrap-around arithmetic + might compute a meangingless size for the object. + +2017-01-23 Justin Squirek + + * a-wtenau.adb, par-endh.adb, sem_prag.adb, + sem_type.adb: Code cleanups. + 2017-01-23 Bob Duff * sem_res.adb (Resolve_Call): In the part of the code where diff --git a/gcc/ada/a-wtenau.adb b/gcc/ada/a-wtenau.adb index d09306bb756..709703e95af 100644 --- a/gcc/ada/a-wtenau.adb +++ b/gcc/ada/a-wtenau.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -304,8 +304,6 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is exit when Is_Character (WC) - and then - not Is_Letter (To_Character (WC)) and then not Is_Letter (To_Character (WC)) and then diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 0acd94f1ab9..402434964bc 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5465,6 +5465,13 @@ package body Exp_Ch3 is -- value, it may be possible to build an equivalent aggregate instead, -- and prevent an actual call to the initialization procedure. + procedure Check_Large_Modular_Array; + -- Check that the size of the array can be computed without overflow, + -- and generate a Storage_Error otherwise. This is only relevant for + -- array types whose index in a (mod 2**64) type, where wrap-around + -- arithmetic might yield a meaningless value for the length of the + -- array, or its corresponding attribute. + procedure Default_Initialize_Object (After : Node_Id); -- Generate all default initialization actions for object Def_Id. Any -- new code is inserted after node After. @@ -5602,6 +5609,58 @@ package body Exp_Ch3 is end if; end Build_Equivalent_Aggregate; + ------------------------------- + -- Check_Large_Modular_Array -- + ------------------------------- + + procedure Check_Large_Modular_Array is + Index_Typ : Entity_Id; + + begin + if Is_Array_Type (Typ) + and then Is_Modular_Integer_Type (Etype (First_Index (Typ))) + then + -- To prevent arithmetic overflow with large values, we + -- raise Storage_Error under the following guard: + -- + -- (Arr'Last / 2 - Arr'First / 2) > (Typ'Last - 1) / 2 + + -- This takes care of the boundary case, but it is preferable + -- to use a smaller limit, because even on 64-bit architectures + -- an array of more than 2 ** 30 bytes is likely to raise + -- Storage_Error. + + Index_Typ := Etype (First_Index (Typ)); + if RM_Size (Index_Typ) = RM_Size (Standard_Long_Long_Integer) then + Insert_Action (N, + Make_Raise_Storage_Error (Loc, + Condition => + Make_Op_Ge (Loc, + Left_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => + Make_Op_Divide (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Typ, Loc), + Attribute_Name => Name_Last), + Right_Opnd => + Make_Integer_Literal (Loc, Uint_2)), + Right_Opnd => + Make_Op_Divide (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Typ, Loc), + Attribute_Name => Name_First), + Right_Opnd => + Make_Integer_Literal (Loc, Uint_2))), + Right_Opnd => + Make_Integer_Literal (Loc, (Uint_2 ** 30))), + Reason => SE_Object_Too_Large)); + end if; + end if; + end Check_Large_Modular_Array; + ------------------------------- -- Default_Initialize_Object -- ------------------------------- @@ -6012,6 +6071,8 @@ package body Exp_Ch3 is Build_Master_Entity (Def_Id); end if; + Check_Large_Modular_Array; + -- Default initialization required, and no expression present if No (Expr) then diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index d2772caf1e0..2ae495e0f34 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9038,13 +9038,12 @@ package body Exp_Ch9 is & "violate restriction " & "No_Implicit_Heap_Allocations??", Priv, Prot_Typ); else - -- Object will be non-static if discriminants are Error_Msg_NE ("creation of protected object of type& with " - & "non-static discriminants will violate" - & " restriction No_Implicit_Heap_Allocations??", + & "non-static discriminants will violate " + & "restriction No_Implicit_Heap_Allocations??", Priv, Prot_Typ); end if; @@ -9068,7 +9067,7 @@ package body Exp_Ch9 is Error_Msg_NE ("creation of protected object of type& with " - & "non-static discriminants will violate " + & "non-static discriminants will violate " & "restriction " & "No_Implicit_Protected_Object_Allocations??", Priv, Prot_Typ); diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index 3c065ec9fb9..bbcbff92c13 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -576,7 +576,6 @@ package body Endh is -- Cases of normal tokens following an END (Token = Tok_Case or else - Token = Tok_For or else Token = Tok_If or else Token = Tok_Loop or else Token = Tok_Record or else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f1520d54d9e..f34e2ff7f5a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -23951,7 +23951,7 @@ package body Sem_Prag is -- Attribute 'Result matches attribute 'Result elsif Is_Attribute_Result (Dep_Item) - and then Is_Attribute_Result (Dep_Item) + and then Is_Attribute_Result (Ref_Item) then Matched := True; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 555184a3928..26415ae47db 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2578,7 +2578,6 @@ package body Sem_Type is loop if Present (Interfaces (E)) - and then Present (Interfaces (E)) and then not Is_Empty_Elmt_List (Interfaces (E)) then Elmt := First_Elmt (Interfaces (E));