Skip to content

R
riscv-gcc-1
Commit 64a4f612 by Arnaud Charlet
Options

[multiple changes] 

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra
	spaces from error messages.

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* 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  <squirek@adacore.com>

	* a-wtenau.adb, par-endh.adb, sem_prag.adb,
	sem_type.adb: Code cleanups.

From-SVN: r244775
parent be4e989c
Showing with 87 additions and 11 deletions
gcc/ada/ChangeLog
2017-01-23 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra
spaces from error messages.
2017-01-23 Ed Schonberg <schonberg@adacore.com>
* 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 <squirek@adacore.com>
* a-wtenau.adb, par-endh.adb, sem_prag.adb,
sem_type.adb: Code cleanups.
2017-01-23 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Call): In the part of the code where
......
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- --
......@@ -307,8 +307,6 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
and then
not Is_Letter (To_Character (WC))
and then
not Is_Letter (To_Character (WC))
and then
(WC /= '_' or else From (Stop - 1) = '_');
Stop := Stop + 1;
......
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.
......@@ -5603,6 +5610,58 @@ package body Exp_Ch3 is
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
......
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);
......
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
......
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;
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));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment