exp_strm.adb (Build_Elementary_Input_Call): Clarify comments in previous checkin.

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

	* exp_strm.adb (Build_Elementary_Input_Call): Clarify comments
	in previous checkin.
	* freeze.adb (Freeze_Fixed_Point_Type): Add warning for shaving
	of bounds.
	* sem_prag.adb, sem_ch10.adb, sem_ch6.adb: Minor reformatting.

From-SVN: r219229

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 82e4b13..c66023d 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2015-01-06  Robert Dewar  <dewar@adacore.com>
+
+       * exp_strm.adb (Build_Elementary_Input_Call): Clarify comments
+       in previous checkin.
+       * freeze.adb (Freeze_Fixed_Point_Type): Add warning for shaving
+       of bounds.
+       * sem_prag.adb, sem_ch10.adb, sem_ch6.adb: Minor reformatting.
+
 2015-01-06  Vincent Celier  <celier@adacore.com>
 
        * a-strsup.adb (Times (Natural;String;Positive)): Raise

diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb
index 7186de4..21d9447 100644 (file)
--- a/gcc/ada/exp_strm.adb
+++ b/gcc/ada/exp_strm.adb
@@ -650,7 +650,8 @@ package body Exp_Strm is
 
          --  Now convert to the base type if we do not have a biased type. Note
          --  that we did not do this in some older versions, and the result was
-         --  losing some required range checking for the 'Read case.
+         --  losing a required range check in the case where 'Input is being
+         --  called from 'Read.
 
          if not Has_Biased_Representation (P_Type) then
             return Unchecked_Convert_To (Base_Type (P_Type), Res);
@@ -683,7 +684,6 @@ package body Exp_Strm is
       Libent  : Entity_Id;
 
    begin
-
       --  Compute the size of the stream element. This is either the size of
       --  the first subtype or if given the size of the Stream_Size attribute.
 

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 4765d8e..cc5553e 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6711,7 +6711,12 @@ package body Freeze is
       Hival : Ureal;
       Atype : Entity_Id;
 
+      Orig_Lo : Ureal;
+      Orig_Hi : Ureal;
+      --  Save original bounds (for shaving tests)
+
       Actual_Size : Nat;
+      --  Actual size chosen
 
       function Fsize (Lov, Hiv : Ureal) return Nat;
       --  Returns size of type with given bounds. Also leaves these
@@ -6762,6 +6767,9 @@ package body Freeze is
       Loval := Realval (Lo);
       Hival := Realval (Hi);
 
+      Orig_Lo := Loval;
+      Orig_Hi := Hival;
+
       --  Ordinary fixed-point case
 
       if Is_Ordinary_Fixed_Point_Type (Typ) then
@@ -7130,6 +7138,24 @@ package body Freeze is
             Set_RM_Size (Typ, Minsiz);
          end if;
       end;
+
+      --  Check for shaving
+
+      if Comes_From_Source (Typ) then
+         if Orig_Lo < Expr_Value_R (Lo) then
+            Error_Msg_N
+              ("declared low bound of type & is outside type range??", Typ);
+            Error_Msg_N
+              ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ);
+         end if;
+
+         if Orig_Hi > Expr_Value_R (Hi) then
+            Error_Msg_N
+              ("declared high bound of type & is outside type range??", Typ);
+            Error_Msg_N
+              ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ);
+         end if;
+      end if;
    end Freeze_Fixed_Point_Type;
 
    ------------------

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index f482245..39bbcd0 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -6494,6 +6494,10 @@ package body Sem_Ch10 is
          Item := First (Context_Items (Comp_Unit));
          while Present (Item) loop
             if Nkind (Item) = N_With_Clause
+
+              --  The following guard is needed to ensure that the name has
+              --  been properly analyzed before we go fetching its entity.
+
               and then Is_Entity_Name (Name (Item))
               and then Entity (Name (Item)) = E
               and then not Private_Present (Item)

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d0c1f9e..946f217 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -321,7 +321,8 @@ package body Sem_Ch6 is
       --  check whether any of them is completed by the expression function.
       --  In a generic context a formal subprogram has no completion.
 
-      if Present (Prev) and then Is_Overloadable (Prev)
+      if Present (Prev)
+        and then Is_Overloadable (Prev)
         and then not Is_Formal_Subprogram (Prev)
       then
          Def_Id := Analyze_Subprogram_Specification (Spec);
@@ -380,7 +381,8 @@ package body Sem_Ch6 is
       --  scope. The entity itself may be internally created if within a body
       --  to be inlined.
 
-      elsif Present (Prev) and then Comes_From_Source (Parent (Prev))
+      elsif Present (Prev)
+        and then Comes_From_Source (Parent (Prev))
         and then not Is_Formal_Subprogram (Prev)
       then
          Set_Has_Completion (Prev, False);
@@ -2043,7 +2045,7 @@ package body Sem_Ch6 is
 
             elsif Ekind (Typ) = E_Incomplete_Type
               or else (Is_Class_Wide_Type (Typ)
-                         and then Ekind (Root_Type (Typ)) = E_Incomplete_Type)
+                        and then Ekind (Root_Type (Typ)) = E_Incomplete_Type)
             then
                --  AI05-0151: Tagged incomplete types are allowed in all formal
                --  parts. Untagged incomplete types are not allowed in bodies.
@@ -2556,13 +2558,13 @@ package body Sem_Ch6 is
             --  a null access (see Expand_Interface_Conversion)
 
            and then not (Is_Interface (Designated_Type (Etype (Scop)))
-                           and then not Comes_From_Source (Parent (Scop)))
+                          and then not Comes_From_Source (Parent (Scop)))
 
            and then (Has_Task (Designated_Type (Etype (Scop)))
                       or else
-                       (Is_Class_Wide_Type (Designated_Type (Etype (Scop)))
-                          and then
-                        Is_Limited_Record (Designated_Type (Etype (Scop)))))
+                        (Is_Class_Wide_Type (Designated_Type (Etype (Scop)))
+                           and then
+                         Is_Limited_Record (Designated_Type (Etype (Scop)))))
            and then Expander_Active
 
            --  Avoid cases with no tasking support
@@ -2633,9 +2635,8 @@ package body Sem_Ch6 is
               Nkind (N) = N_Pragma
                 and then
                   (Pragma_Name (N) = Name_Inline_Always
-                    or else
-                      (Front_End_Inlining
-                        and then Pragma_Name (N) = Name_Inline))
+                    or else (Front_End_Inlining
+                              and then Pragma_Name (N) = Name_Inline))
                 and then
                   Chars
                     (Expression (First (Pragma_Argument_Associations (N)))) =
@@ -2822,8 +2823,9 @@ package body Sem_Ch6 is
                if To_Corresponding then
                   if Is_Concurrent_Type (Formal_Typ)
                     and then Present (Corresponding_Record_Type (Formal_Typ))
-                    and then Present (Interfaces (
-                               Corresponding_Record_Type (Formal_Typ)))
+                    and then
+                      Present (Interfaces
+                                 (Corresponding_Record_Type (Formal_Typ)))
                   then
                      Set_Etype (Formal,
                        Corresponding_Record_Type (Formal_Typ));
@@ -3018,7 +3020,7 @@ package body Sem_Ch6 is
       begin
          if Must_Override (Body_Spec) then
             if Nkind (Spec_Id) = N_Defining_Operator_Symbol
-              and then  Operator_Matches_Spec (Spec_Id, Spec_Id)
+              and then Operator_Matches_Spec (Spec_Id, Spec_Id)
             then
                null;
 
@@ -3044,7 +3046,7 @@ package body Sem_Ch6 is
                   Body_Spec, Spec_Id);
 
             elsif Nkind (Spec_Id) = N_Defining_Operator_Symbol
-              and then  Operator_Matches_Spec (Spec_Id, Spec_Id)
+              and then Operator_Matches_Spec (Spec_Id, Spec_Id)
             then
                Error_Msg_NE
                  ("subprogram& overrides predefined operator ",
@@ -3407,7 +3409,7 @@ package body Sem_Ch6 is
               and then not Comes_From_Source (N)
               and then
                 (Nkind (Original_Node (Spec_Decl)) =
-                                        N_Subprogram_Renaming_Declaration
+                                          N_Subprogram_Renaming_Declaration
                   or else (Present (Corresponding_Body (Spec_Decl))
                             and then
                               Nkind (Unit_Declaration_Node
@@ -4962,19 +4964,19 @@ package body Sem_Ch6 is
            --  F_Ptr. We catch this case in the code below.
 
            and then (Ekind (Old_Formal_Base) = Ekind (New_Formal_Base)
-                  or else
-                    (Is_Generic_Type (Old_Formal_Base)
-                       and then Is_Generic_Type (New_Formal_Base)
-                       and then Is_Internal (New_Formal_Base)
-                       and then Etype (Etype (New_Formal_Base)) =
-                                  Old_Formal_Base))
-           and then Directly_Designated_Type (Old_Formal_Base) =
-                    Directly_Designated_Type (New_Formal_Base)
+                      or else
+                        (Is_Generic_Type (Old_Formal_Base)
+                          and then Is_Generic_Type (New_Formal_Base)
+                          and then Is_Internal (New_Formal_Base)
+                          and then Etype (Etype (New_Formal_Base)) =
+                                                          Old_Formal_Base))
+               and then Directly_Designated_Type (Old_Formal_Base) =
+                                    Directly_Designated_Type (New_Formal_Base)
            and then ((Is_Itype (Old_Formal_Base)
                        and then Can_Never_Be_Null (Old_Formal_Base))
-                    or else
-                     (Is_Itype (New_Formal_Base)
-                       and then Can_Never_Be_Null (New_Formal_Base)));
+                     or else
+                      (Is_Itype (New_Formal_Base)
+                        and then Can_Never_Be_Null (New_Formal_Base)));
 
          --  Types must always match. In the visible part of an instance,
          --  usual overloading rules for dispatching operations apply, and

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8798fa1..dad23da 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1382,8 +1382,7 @@ package body Sem_Prag is
 
                --    (Output =>+ null)
 
-               --  Remove the null input and replace it with a copy of the
-               --  output:
+               --  Remove null input and replace it with a copy of the output:
 
                --    (Output => Output)
 
@@ -1459,8 +1458,8 @@ package body Sem_Prag is
                Propagate_Output (Output, Inputs);
 
                --  A list with multiple outputs is slowly trimmed until only
-               --  one element remains. When this happens, replace the
-               --  aggregate with the element itself.
+               --  one element remains. When this happens, replace aggregate
+               --  with the element itself.
 
                if Multiple then
                   Remove  (Output);