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

gcc/ada/ChangeLog

+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

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.
 

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;
 
    ------------------

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)

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);
@@ -2633,8 +2635,7 @@ package body Sem_Ch6 is
               Nkind (N) = N_Pragma
                 and then
                   (Pragma_Name (N) = Name_Inline_Always
-                    or else
-                      (Front_End_Inlining
+                    or else (Front_End_Inlining
                               and then Pragma_Name (N) = Name_Inline))
                 and then
                   Chars
@@ -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));

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);