Skip to content

R
riscv-gcc-1
Commit 1a779058 by Arnaud Charlet
Options

[multiple changes] 

2015-01-06  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb (Set_SSO_From_Defaults): When setting scalar storage
	order to native from default, make sure to also adjust bit order.
	* exp_aggr.adb: Minor reformatting.

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* s-valllu.adb, s-valllu.ads, s-valuti.ads, s-valuns.adb, s-valuns.ads,
	s-valrea.adb, s-valrea.ads: Add some additional guards for
	Str'Last = Positive'Last.

2015-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb, sem_ch8.adb: Ongoing work for wrappers for actual
	subprograms.

2015-01-06  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Conversion): Reapply patch.

From-SVN: r219250
parent 375cbc2b
Showing with 113 additions and 24 deletions
gcc/ada/ChangeLog
2015-01-06 Thomas Quinot <quinot@adacore.com>
* freeze.adb (Set_SSO_From_Defaults): When setting scalar storage
order to native from default, make sure to also adjust bit order.
* exp_aggr.adb: Minor reformatting.
2015-01-06 Robert Dewar <dewar@adacore.com>
* s-valllu.adb, s-valllu.ads, s-valuti.ads, s-valuns.adb, s-valuns.ads,
s-valrea.adb, s-valrea.ads: Add some additional guards for
Str'Last = Positive'Last.
2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb, sem_ch8.adb: Ongoing work for wrappers for actual
subprograms.
2015-01-06 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Expand_Interface_Conversion): Reapply patch.
2015-01-06 Thomas Quinot <quinot@adacore.com>
* sem_util.ads: Minor reformatting.
* sem_cat.adb (In_RCI_Visible_Declarations): Change back to...
(In_RCI_Declaration) Return to old name, as proper checking of
......
gcc/ada/exp_aggr.adb
......@@ -239,10 +239,10 @@ package body Exp_Aggr is
-- Packed_Array_Aggregate_Handled, we set this parameter to True, since
-- these are cases we handle in there.
-- It would seem worthwhile to have a higher default value for Max_Others_
-- replicate, but aggregates in the compiler make this impossible: the
-- compiler bootstrap fails if Max_Others_Replicate is greater than 25.
-- This is unexpected ???
-- It would seem useful to have a higher default for Max_Others_Replicate,
-- but aggregates in the compiler make this impossible: the compiler
-- bootstrap fails if Max_Others_Replicate is greater than 25. This
-- is unexpected ???
procedure Expand_Array_Aggregate (N : Node_Id);
-- This is the top-level routine to perform array aggregate expansion.
......
gcc/ada/exp_disp.adb
......@@ -1138,6 +1138,25 @@ package body Exp_Disp is
Operand_Typ := Base_Type (Corresponding_Record_Type (Operand_Typ));
end if;
-- No displacement of the pointer to the object needed when the type of
-- the operand is not an interface type and the interface is one of
-- its parent types (since they share the primary dispatch table).
declare
Opnd : Entity_Id := Operand_Typ;
begin
if Is_Access_Type (Opnd) then
Opnd := Designated_Type (Opnd);
end if;
if not Is_Interface (Opnd)
and then Is_Ancestor (Iface_Typ, Opnd, Use_Full_View => True)
then
return;
end if;
end;
-- Evaluate if we can statically displace the pointer to the object
declare
......
gcc/ada/freeze.adb
......@@ -7748,6 +7748,8 @@ package body Freeze is
--------------------------
procedure Set_SSO_From_Default (T : Entity_Id) is
Reversed : Boolean;
begin
-- Set default SSO for an array or record base type, except in case of
-- a type extension (which always inherits the SSO of its parent type).
......@@ -7758,31 +7760,35 @@ package body Freeze is
and then not (Is_Tagged_Type (T)
and then Is_Derived_Type (T))))
then
if ((Bytes_Big_Endian and then SSO_Set_Low_By_Default (T))
or else
((not Bytes_Big_Endian) and then SSO_Set_High_By_Default (T)))
Reversed :=
(Bytes_Big_Endian and then SSO_Set_Low_By_Default (T))
or else
(not Bytes_Big_Endian and then SSO_Set_High_By_Default (T));
if (SSO_Set_Low_By_Default (T) or else SSO_Set_High_By_Default (T))
-- For a record type, if native bit order is specified explicitly,
-- then never set reverse SSO from default.
-- For a record type, if bit order is specified explicitly, then
-- do not set SSO from default if not consistent.
and then not
(Is_Record_Type (T)
and then Has_Rep_Item (T, Name_Bit_Order)
and then not Reverse_Bit_Order (T))
and then Reverse_Bit_Order (T) /= Reversed)
then
-- If flags cause reverse storage order, then set the result. Note
-- that we would have ignored the pragma setting the non default
-- storage order in any case, hence the assertion at this point.
pragma Assert (Support_Nondefault_SSO_On_Target);
Set_Reverse_Storage_Order (T);
pragma Assert
(not Reversed or else Support_Nondefault_SSO_On_Target);
Set_Reverse_Storage_Order (T, Reversed);
-- For a record type, also set reversed bit order. Note that if
-- a bit order has been specified explicitly, then this is a
-- no-op, as per the guard above.
-- For a record type, also set reversed bit order. Note: if a bit
-- order has been specified explicitly, then this is a no-op.
if Is_Record_Type (T) then
Set_Reverse_Bit_Order (T);
Set_Reverse_Bit_Order (T, Reversed);
end if;
end if;
end if;
......
gcc/ada/s-valllu.adb
......@@ -65,6 +65,13 @@ package body System.Val_LLU is
-- Digit value
begin
-- We do not tolerate strings with Str'Last = Positive'Last
if Str'Last = Positive'Last then
raise Program_Error with
"string upper bound is Positive'Last, not supported";
end if;
P := Ptr.all;
Uval := Character'Pos (Str (P)) - Character'Pos ('0');
P := P + 1;
......
gcc/ada/s-valllu.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -66,6 +66,10 @@ package System.Val_LLU is
-- Note: if Str is empty, i.e. if Max is less than Ptr, then this is a
-- special case of an all-blank string, and Ptr is unchanged, and hence
-- is greater than Max as required in this case.
--
-- Note: this routine should not be called with Str'Last = Positive'Last.
-- If this occurs Program_Error is raised with a message noting that this
-- case is not supported. Most such cases are eliminated by the caller.
function Scan_Long_Long_Unsigned
(Str : String;
......@@ -73,6 +77,7 @@ package System.Val_LLU is
Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned;
-- Same as Scan_Raw_Long_Long_Unsigned, except scans optional leading
-- blanks, and an optional leading plus sign.
--
-- Note: if a minus sign is present, Constraint_Error will be raised.
-- Note: trailing blanks are not scanned.
......
gcc/ada/s-valrea.adb
......@@ -152,6 +152,13 @@ package body System.Val_Real is
-- Start of processing for System.Scan_Real
begin
-- We do not tolerate strings with Str'Last = Positive'Last
if Str'Last = Positive'Last then
raise Program_Error with
"string upper bound is Positive'Last, not supported";
end if;
-- We call the floating-point processor reset routine so that we can
-- be sure the floating-point processor is properly set for conversion
-- calls. This is notably need on Windows, where calls to the operating
......
gcc/ada/s-valrea.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -60,6 +60,10 @@ package System.Val_Real is
-- Note: if Str is null, i.e. if Max is less than Ptr, then this is a
-- special case of an all-blank string, and Ptr is unchanged, and hence
-- is greater than Max as required in this case.
--
-- Note: this routine should not be called with Str'Last = Positive'Last.
-- If this occurs Program_Error is raised with a message noting that this
-- case is not supported. Most such cases are eliminated by the caller.
function Value_Real (Str : String) return Long_Long_Float;
-- Used in computing X'Value (Str) where X is a floating-point type or an
......
gcc/ada/s-valuns.adb
......@@ -65,6 +65,13 @@ package body System.Val_Uns is
-- Digit value
begin
-- We do not tolerate strings with Str'Last = Positive'Last
if Str'Last = Positive'Last then
raise Program_Error with
"string upper bound is Positive'Last, not supported";
end if;
P := Ptr.all;
Uval := Character'Pos (Str (P)) - Character'Pos ('0');
P := P + 1;
......
gcc/ada/s-valuns.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -66,6 +66,10 @@ package System.Val_Uns is
-- Note: if Str is empty, i.e. if Max is less than Ptr, then this is a
-- special case of an all-blank string, and Ptr is unchanged, and hence
-- is greater than Max as required in this case.
--
-- Note: this routine should not be called with Str'Last = Positive'Last.
-- If this occurs Program_Error is raised with a message noting that this
-- case is not supported. Most such cases are eliminated by the caller.
function Scan_Unsigned
(Str : String;
......@@ -73,6 +77,7 @@ package System.Val_Uns is
Max : Integer) return System.Unsigned_Types.Unsigned;
-- Same as Scan_Raw_Unsigned, except scans optional leading
-- blanks, and an optional leading plus sign.
--
-- Note: if a minus sign is present, Constraint_Error will be raised.
-- Note: trailing blanks are not scanned.
......
gcc/ada/s-valuti.ads
......@@ -71,6 +71,9 @@ package System.Val_Util is
-- special case of an all-blank string, and Ptr is unchanged, and hence
-- is greater than Max as required in this case. Constraint_Error is also
-- raised in this case.
--
-- This routine must not be called with Str'Last = Positive'Last. There is
-- no check for this case, the caller must ensure this condition is met.
procedure Scan_Plus_Sign
(Str : String;
......@@ -95,6 +98,9 @@ package System.Val_Util is
-- returning a suitable large value. If the base is zero, then any value
-- is allowed, and otherwise the large value will either cause underflow
-- or overflow during the scaling process which is fine.
--
-- This routine must not be called with Str'Last = Positive'Last. There is
-- no check for this case, the caller must ensure this condition is met.
procedure Scan_Trailing_Blanks (Str : String; P : Positive);
-- Checks that the remainder of the field Str (P .. Str'Last) is all
......@@ -113,5 +119,8 @@ package System.Val_Util is
-- where the underscore is invalid, Constraint_Error is raised with Ptr
-- set appropriately, otherwise control returns with P incremented past
-- the underscore.
--
-- This routine must not be called with Str'Last = Positive'Last. There is
-- no check for this case, the caller must ensure this condition is met.
end System.Val_Util;
gcc/ada/sem_ch8.adb
......@@ -3457,19 +3457,18 @@ package body Sem_Ch8 is
-- points of call within an instance. Wrappers are generated if formal
-- subprogram is subject to axiomatization.
-- The types in the wrapper profiles are obtained from (instances of)
-- the types of the formal subprogram.
if Is_Actual
and then GNATprove_Mode
and then Present (Containing_Package_With_Ext_Axioms (Formal_Spec))
and then not Inside_A_Generic
then
if Ekind (Old_S) = E_Function then
Rewrite (N, Build_Function_Wrapper (New_S, Old_S));
Rewrite (N, Build_Function_Wrapper (Formal_Spec, Old_S));
Analyze (N);
-- For wrappers of operators, the types are obtained from (the
-- instances of) the types of the formal subprogram, not from the
-- actual subprogram, that carries predefined types.
elsif Ekind (Old_S) = E_Operator then
Rewrite (N, Build_Operator_Wrapper (Formal_Spec, Old_S));
Analyze (N);
......
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