2014-07-30 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 30 Jul 2014 14:49:38 +0000 (14:49 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 30 Jul 2014 14:49:38 +0000 (14:49 +0000)
* sem_ch13.adb (Analyze_Aspect_Specifications): Default_Value and
Default_Component_Value can only be specified for scalar type or
arrays of scalar types respectively.  This legality check must
be performed at the point the aspect is analyzed, in order to
reject aspect specifications that apply to a partial view.

2014-07-30  Thomas Quinot  <quinot@adacore.com>

* freeze.adb: Minor reformatting.

2014-07-30  Robert Dewar  <dewar@adacore.com>

* exp_attr.adb (Expand_Attribute, case First/Last): Don't expand in
codepeer mode.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213289 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_attr.adb
gcc/ada/freeze.adb
gcc/ada/sem_ch13.adb

index df58f1a..2fda6e8 100644 (file)
@@ -1,5 +1,22 @@
 2014-07-30  Ed Schonberg  <schonberg@adacore.com>
 
+       * sem_ch13.adb (Analyze_Aspect_Specifications): Default_Value and
+       Default_Component_Value can only be specified for scalar type or
+       arrays of scalar types respectively.  This legality check must
+       be performed at the point the aspect is analyzed, in order to
+       reject aspect specifications that apply to a partial view.
+
+2014-07-30  Thomas Quinot  <quinot@adacore.com>
+
+       * freeze.adb: Minor reformatting.
+
+2014-07-30  Robert Dewar  <dewar@adacore.com>
+
+       * exp_attr.adb (Expand_Attribute, case First/Last): Don't expand in
+       codepeer mode.
+
+2014-07-30  Ed Schonberg  <schonberg@adacore.com>
+
        * freeze.adb (Check_Expression_Function): At the freeze point
        of an expression function, verify that the expression in the
        function does not contain references to any deferred constants
index 43051fa..b121fce 100644 (file)
@@ -2884,9 +2884,11 @@ package body Exp_Attr is
          --  For scalar type, if low bound is a reference to an entity, just
          --  replace with a direct reference. Note that we can only have a
          --  reference to a constant entity at this stage, anything else would
-         --  have already been rewritten.
+         --  have already been rewritten. We do not do this rewriting if we
+         --  are in CodePeer mode, since CodePeer prefers to see the explicit
+         --  First attribute reference.
 
-         elsif Is_Scalar_Type (Ptyp) then
+         elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
             declare
                Lo : constant Node_Id := Type_Low_Bound (Ptyp);
             begin
@@ -3560,9 +3562,11 @@ package body Exp_Attr is
          --  For scalar type, if low bound is a reference to an entity, just
          --  replace with a direct reference. Note that we can only have a
          --  reference to a constant entity at this stage, anything else would
-         --  have already been rewritten.
+         --  have already been rewritten. We do not do this rewriting if we
+         --  are in CodePeer mode, since CodePeer prefers to see the explicit
+         --  Last attribute reference.
 
-         elsif Is_Scalar_Type (Ptyp) then
+         elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
             declare
                Hi : constant Node_Id := Type_High_Bound (Ptyp);
             begin
index abc84cc..5864dfc 100644 (file)
@@ -108,8 +108,8 @@ package body Freeze is
    procedure Check_Expression_Function (N : Node_Id; Nam : Entity_Id);
    --  When an expression function is frozen by a use of it, the expression
    --  itself is frozen. Check that the expression does not include references
-   --  to deferred constants without completion.  We report this at the
-   --  freeze point of the function, to provide a better error message.
+   --  to deferred constants without completion. We report this at the freeze
+   --  point of the function, to provide a better error message.
 
    procedure Check_Strict_Alignment (E : Entity_Id);
    --  E is a base type. If E is tagged or has a component that is aliased
index f359b48..6143299 100644 (file)
@@ -2618,10 +2618,28 @@ package body Sem_Ch13 is
                --  Case 3a: The aspects listed below don't correspond to
                --  pragmas/attributes but do require delayed analysis.
 
-               --  Default_Value, Default_Component_Value
+               --  Default_Value can only apply to a scalar type
+
+               when Aspect_Default_Value =>
+                  if not Is_Scalar_Type (E) then
+                     Error_Msg_N
+                       ("aspect Default_Value must apply to a scalar_Type", N);
+                  end if;
+
+                  Aitem := Empty;
+
+               --  Default_Component_Value can only apply to an array type
+               --  with scalar components.
+
+               when Aspect_Default_Component_Value =>
+                  if not (Is_Array_Type (E)
+                            and then
+                          Is_Scalar_Type (Component_Type (E)))
+                  then
+                     Error_Msg_N ("aspect Default_Component_Value can only "
+                       & "apply to an array of scalar components", N);
+                  end if;
 
-               when Aspect_Default_Value           |
-                    Aspect_Default_Component_Value =>
                   Aitem := Empty;
 
                --  Case 3b: The aspects listed below don't correspond to
@@ -2692,7 +2710,7 @@ package body Sem_Ch13 is
                   --  or precondition error).
 
                   --  We do not do this for Pre'Class, since we have to put
-                  --  these conditions together in a complex OR expression
+                  --  these conditions together in a complex OR expression.
 
                   --  We do not do this in ASIS mode, as ASIS relies on the
                   --  original node representing the complete expression, when
@@ -2716,7 +2734,7 @@ package body Sem_Ch13 is
 
                   --  Build the precondition/postcondition pragma
 
-                  --  Add note about why we do NOT need Copy_Tree here ???
+                  --  Add note about why we do NOT need Copy_Tree here???
 
                   Make_Aitem_Pragma
                     (Pragma_Argument_Associations => New_List (
@@ -2776,9 +2794,9 @@ package body Sem_Ch13 is
                   end if;
 
                   --  Make pragma expressions refer to the original aspect
-                  --  expressions through the Original_Node link. This is
-                  --  used in semantic analysis for ASIS mode, so that the
-                  --  original expression also gets analyzed.
+                  --  expressions through the Original_Node link. This is used
+                  --  in semantic analysis for ASIS mode, so that the original
+                  --  expression also gets analyzed.
 
                   Comp_Expr := First (Expressions (Expr));
                   while Present (Comp_Expr) loop
@@ -2885,8 +2903,8 @@ package body Sem_Ch13 is
                      end if;
 
                      --  In older versions of Ada the corresponding pragmas
-                     --  specified a Convention. In Ada 2012 the convention
-                     --  is specified as a separate aspect, and it is optional,
+                     --  specified a Convention. In Ada 2012 the convention is
+                     --  specified as a separate aspect, and it is optional,
                      --  given that it defaults to Convention_Ada. The code
                      --  that verifed that there was a matching convention
                      --  is now obsolete.
@@ -2947,8 +2965,8 @@ package body Sem_Ch13 is
                            Pragma_Name                  => Nam);
                      end;
 
-                  --  Cases where we do not delay, includes all cases where
-                  --  the expression is missing other than the above cases.
+                  --  Cases where we do not delay, includes all cases where the
+                  --  expression is missing other than the above cases.
 
                   elsif not Delay_Required or else No (Expr) then
                      Make_Aitem_Pragma
@@ -2997,8 +3015,8 @@ package body Sem_Ch13 is
                                End_Label            => Empty));
                         end if;
 
-                        --  Create a pragma and put it at the start of the
-                        --  task definition for the task type declaration.
+                        --  Create a pragma and put it at the start of the task
+                        --  definition for the task type declaration.
 
                         Make_Aitem_Pragma
                           (Pragma_Argument_Associations => New_List (
@@ -3033,10 +3051,10 @@ package body Sem_Ch13 is
             --  In the context of a compilation unit, we directly put the
             --  pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
             --  node (no delay is required here) except for aspects on a
-            --  subprogram body (see below) and a generic package, for which
-            --  we need to introduce the pragma before building the generic
-            --  copy (see sem_ch12), and for package instantiations, where
-            --  the library unit pragmas are better handled early.
+            --  subprogram body (see below) and a generic package, for which we
+            --  need to introduce the pragma before building the generic copy
+            --  (see sem_ch12), and for package instantiations, where the
+            --  library unit pragmas are better handled early.
 
             if Nkind (Parent (N)) = N_Compilation_Unit
               and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -3233,12 +3251,12 @@ package body Sem_Ch13 is
 
       FOnly : Boolean := False;
       --  Reset to True for subtype specific attribute (Alignment, Size)
-      --  and for stream attributes, i.e. those cases where in the call
-      --  to Rep_Item_Too_Late, FOnly is set True so that only the freezing
-      --  rules are checked. Note that the case of stream attributes is not
-      --  clear from the RM, but see AI95-00137. Also, the RM seems to
-      --  disallow Storage_Size for derived task types, but that is also
-      --  clearly unintentional.
+      --  and for stream attributes, i.e. those cases where in the call to
+      --  Rep_Item_Too_Late, FOnly is set True so that only the freezing rules
+      --  are checked. Note that the case of stream attributes is not clear
+      --  from the RM, but see AI95-00137. Also, the RM seems to disallow
+      --  Storage_Size for derived task types, but that is also clearly
+      --  unintentional.
 
       procedure Analyze_Stream_TSS_Definition (TSS_Nam : TSS_Name_Type);
       --  Common processing for 'Read, 'Write, 'Input and 'Output attribute
@@ -3321,9 +3339,8 @@ package body Sem_Ch13 is
                Typ := Etype (F);
 
                --  If the attribute specification comes from an aspect
-               --  specification for a class-wide stream, the parameter
-               --  must be a class-wide type of the entity to which the
-               --  aspect applies.
+               --  specification for a class-wide stream, the parameter must be
+               --  a class-wide type of the entity to which the aspect applies.
 
                if From_Aspect_Specification (N)
                  and then Class_Present (Parent (N))
@@ -3336,8 +3353,8 @@ package body Sem_Ch13 is
                Typ := Etype (Subp);
             end if;
 
-            --  Verify that the prefix of the attribute and the local name
-            --  for the type of the formal match.
+            --  Verify that the prefix of the attribute and the local name for
+            --  the type of the formal match.
 
             if Base_Type (Typ) /= Base_Type (Ent)
               or else Present ((Next_Formal (F)))
@@ -3709,8 +3726,8 @@ package body Sem_Ch13 is
 
    begin
       --  The following code is a defense against recursion. Not clear that
-      --  this can happen legitimately, but perhaps some error situations
-      --  can cause it, and we did see this recursion during testing.
+      --  this can happen legitimately, but perhaps some error situations can
+      --  cause it, and we did see this recursion during testing.
 
       if Analyzed (N) then
          return;
@@ -3760,10 +3777,10 @@ package body Sem_Ch13 is
                return;
 
             --  The following should not be ignored, because in the first place
-            --  they are reasonably portable, and should not cause problems in
-            --  compiling code from another target, and also they do affect
-            --  legality, e.g. failing to provide a stream attribute for a
-            --  type may make a program illegal.
+            --  they are reasonably portable, and should not cause problems
+            --  in compiling code from another target, and also they do affect
+            --  legality, e.g. failing to provide a stream attribute for a type
+            --  may make a program illegal.
 
             when Attribute_External_Tag        |
                  Attribute_Input               |