Skip to content

R
riscv-gcc-1
Commit 7b55fea6 by Arnaud Charlet
Options

[multiple changes] 

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* par-ch4.adb (P_Allocator): In Ada 2012 (AI05-0104)  an
	uninitialized allocator cannot carry an explicit not null
	indicator.
	* sem_ch4.adb (Analyze_Allocator): Remove code that implements
	the check for AI05-0104, the check is syntactic and performed
	in the parser.

2012-12-05  Geert Bosch  <bosch@adacore.com>

	* sem_attr.adb (Analyze_Attribute): Use base type for floating
	point attributes.

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications,
	Ahalyze_Aspect_Default_Value): For a scalar type attach default
	value to base type as well, because it is a type-specific aspect
	even though it can be specified on a first subtype.

From-SVN: r194209
parent c6fc9e43
Showing with 76 additions and 24 deletions
gcc/ada/ChangeLog
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* par-ch4.adb (P_Allocator): In Ada 2012 (AI05-0104) an
uninitialized allocator cannot carry an explicit not null
indicator.
* sem_ch4.adb (Analyze_Allocator): Remove code that implements
the check for AI05-0104, the check is syntactic and performed
in the parser.
2012-12-05 Geert Bosch <bosch@adacore.com>
* sem_attr.adb (Analyze_Attribute): Use base type for floating
point attributes.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications,
Ahalyze_Aspect_Default_Value): For a scalar type attach default
value to base type as well, because it is a type-specific aspect
even though it can be specified on a first subtype.
2012-12-05 Yannick Moy <moy@adacore.com>
* urealp.ads: Minor rewording.
......
gcc/ada/par-ch4.adb
......@@ -2928,6 +2928,18 @@ package body Ch4 is
Set_Expression
(Alloc_Node,
P_Subtype_Indication (Type_Node, Null_Exclusion_Present));
-- AI05-0104 : an explicit null exclusion is not allowed for an
-- allocator without initialization. In previous versions of the
-- language it just raises constraint error.
if Ada_Version >= Ada_2012
and then Null_Exclusion_Present
then
Error_Msg_N
("an allocator with a subtype indication "
& "cannot have a null exclusion", Alloc_Node);
end if;
end if;
return Alloc_Node;
......
gcc/ada/sem_attr.adb
......@@ -6834,6 +6834,9 @@ package body Sem_Attr is
-- non-static subtypes, even though such references are not static
-- expressions.
-- For VAX float, the root type is an IEEE type. So make sure to use the
-- base type instead of the root-type for floating point attributes.
case Id is
-- Attributes related to Ada 2012 iterators (placeholder ???)
......@@ -6858,7 +6861,7 @@ package body Sem_Attr is
when Attribute_Adjacent =>
Fold_Ureal (N,
Eval_Fat.Adjacent
(P_Root_Type, Expr_Value_R (E1), Expr_Value_R (E2)), Static);
(P_Base_Type, Expr_Value_R (E1), Expr_Value_R (E2)), Static);
---------
-- Aft --
......@@ -6944,7 +6947,7 @@ package body Sem_Attr is
when Attribute_Ceiling =>
Fold_Ureal (N,
Eval_Fat.Ceiling (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Ceiling (P_Base_Type, Expr_Value_R (E1)), Static);
--------------------
-- Component_Size --
......@@ -6962,7 +6965,7 @@ package body Sem_Attr is
when Attribute_Compose =>
Fold_Ureal (N,
Eval_Fat.Compose
(P_Root_Type, Expr_Value_R (E1), Expr_Value (E2)),
(P_Base_Type, Expr_Value_R (E1), Expr_Value (E2)),
Static);
-----------------
......@@ -6982,7 +6985,7 @@ package body Sem_Attr is
when Attribute_Copy_Sign =>
Fold_Ureal (N,
Eval_Fat.Copy_Sign
(P_Root_Type, Expr_Value_R (E1), Expr_Value_R (E2)), Static);
(P_Base_Type, Expr_Value_R (E1), Expr_Value_R (E2)), Static);
--------------
-- Definite --
......@@ -7108,7 +7111,7 @@ package body Sem_Attr is
when Attribute_Exponent =>
Fold_Uint (N,
Eval_Fat.Exponent (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Exponent (P_Base_Type, Expr_Value_R (E1)), Static);
-----------
-- First --
......@@ -7178,7 +7181,7 @@ package body Sem_Attr is
when Attribute_Floor =>
Fold_Ureal (N,
Eval_Fat.Floor (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Floor (P_Base_Type, Expr_Value_R (E1)), Static);
----------
-- Fore --
......@@ -7195,7 +7198,7 @@ package body Sem_Attr is
when Attribute_Fraction =>
Fold_Ureal (N,
Eval_Fat.Fraction (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Fraction (P_Base_Type, Expr_Value_R (E1)), Static);
-----------------------
-- Has_Access_Values --
......@@ -7415,7 +7418,7 @@ package body Sem_Attr is
when Attribute_Leading_Part =>
Fold_Ureal (N,
Eval_Fat.Leading_Part
(P_Root_Type, Expr_Value_R (E1), Expr_Value (E2)), Static);
(P_Base_Type, Expr_Value_R (E1), Expr_Value (E2)), Static);
------------
-- Length --
......@@ -7497,7 +7500,7 @@ package body Sem_Attr is
when Attribute_Machine =>
Fold_Ureal (N,
Eval_Fat.Machine
(P_Root_Type, Expr_Value_R (E1), Eval_Fat.Round, N),
(P_Base_Type, Expr_Value_R (E1), Eval_Fat.Round, N),
Static);
------------------
......@@ -7572,7 +7575,7 @@ package body Sem_Attr is
when Attribute_Machine_Rounding =>
Fold_Ureal (N,
Eval_Fat.Rounding (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Rounding (P_Base_Type, Expr_Value_R (E1)), Static);
--------------------
-- Machine_Rounds --
......@@ -7803,7 +7806,7 @@ package body Sem_Attr is
when Attribute_Model =>
Fold_Ureal (N,
Eval_Fat.Model (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Model (P_Base_Type, Expr_Value_R (E1)), Static);
----------------
-- Model_Emin --
......@@ -7900,7 +7903,7 @@ package body Sem_Attr is
if Is_Floating_Point_Type (P_Type) then
Fold_Ureal (N,
Eval_Fat.Pred (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Pred (P_Base_Type, Expr_Value_R (E1)), Static);
-- Fixed-point case
......@@ -8017,7 +8020,7 @@ package body Sem_Attr is
return;
end if;
Fold_Ureal (N, Eval_Fat.Remainder (P_Root_Type, X, Y), Static);
Fold_Ureal (N, Eval_Fat.Remainder (P_Base_Type, X, Y), Static);
end Remainder;
-----------
......@@ -8049,7 +8052,7 @@ package body Sem_Attr is
when Attribute_Rounding =>
Fold_Ureal (N,
Eval_Fat.Rounding (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Rounding (P_Base_Type, Expr_Value_R (E1)), Static);
---------------
-- Safe_Emax --
......@@ -8124,7 +8127,7 @@ package body Sem_Attr is
when Attribute_Scaling =>
Fold_Ureal (N,
Eval_Fat.Scaling
(P_Root_Type, Expr_Value_R (E1), Expr_Value (E2)), Static);
(P_Base_Type, Expr_Value_R (E1), Expr_Value (E2)), Static);
------------------
-- Signed_Zeros --
......@@ -8238,7 +8241,7 @@ package body Sem_Attr is
if Is_Floating_Point_Type (P_Type) then
Fold_Ureal (N,
Eval_Fat.Succ (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Succ (P_Base_Type, Expr_Value_R (E1)), Static);
-- Fixed-point case
......@@ -8280,7 +8283,7 @@ package body Sem_Attr is
when Attribute_Truncation =>
Fold_Ureal (N,
Eval_Fat.Truncation (P_Root_Type, Expr_Value_R (E1)), Static);
Eval_Fat.Truncation (P_Base_Type, Expr_Value_R (E1)), Static);
----------------
-- Type_Class --
......@@ -8345,7 +8348,7 @@ package body Sem_Attr is
when Attribute_Unbiased_Rounding =>
Fold_Ureal (N,
Eval_Fat.Unbiased_Rounding (P_Root_Type, Expr_Value_R (E1)),
Eval_Fat.Unbiased_Rounding (P_Base_Type, Expr_Value_R (E1)),
Static);
-------------------------
......
gcc/ada/sem_ch13.adb
......@@ -738,6 +738,14 @@ package body Sem_Ch13 is
if Is_Scalar_Type (Ent) then
Set_Default_Aspect_Value (Ent, Expr);
-- Place default value of base type as well, because that is
-- the semantics of the aspect. It is convenient to link the
-- aspect to both the (possibly anonymous) base type and to
-- the given first subtype.
Set_Default_Aspect_Value (Base_Type (Ent), Expr);
else
Set_Default_Aspect_Component_Value (Ent, Expr);
end if;
......@@ -1892,6 +1900,19 @@ package body Sem_Ch13 is
end if;
Set_Is_Delayed_Aspect (Aspect);
-- In the case of Default_Value, link aspect to base type
-- as well, even though it appears on a first subtype. This
-- is mandated by the semantics of the aspect. Verify that
-- this a scalar type, to prevent cascaded errors.
if A_Id = Aspect_Default_Value
and then Is_Scalar_Type (E)
then
Set_Has_Delayed_Aspects (Base_Type (E));
Record_Rep_Item (Base_Type (E), Aspect);
end if;
Set_Has_Delayed_Aspects (E);
Record_Rep_Item (E, Aspect);
......
gcc/ada/sem_ch4.adb
......@@ -631,12 +631,7 @@ package body Sem_Ch4 is
Reason => CE_Null_Not_Allowed);
begin
if Ada_Version >= Ada_2012 then
Error_Msg_N
("an uninitialized allocator cannot have"
& " a null exclusion", N);
elsif Expander_Active then
if Expander_Active then
Insert_Action (N, Not_Null_Check);
Analyze (Not_Null_Check);
......
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