[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7a46c4d11cbf8b667d962fba015cfca1d43ea3da..de4c3cafa4042b47940461b1ccb5596ee9816208 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+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.

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 8107c89096c9419cf319631ea5bedb437eca2f8a..4ea664d0bc23f26cb8750cb2a892f3a851e46007 100644 (file)
--- a/gcc/ada/par-ch4.adb
+++ b/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;

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index aa61f85e723b1c84ee3c7519842c5a6692a69525..a6ac9cae5485a9e02813b37b310cb25fd1a5fe42 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/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);
 
       -------------------------

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b5acf08e073032124c9968a1700f4970a9c2b632..93889d4f2742779d4c2909525f3671e39a76812d 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/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);
 

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 12d25c996086bfca37de8019b7d2b1f0678ba642..718af47f17cd4a514604149150f1afaea8ad1a02 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/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);