gnat_ugn.texi: Minor spelling correction.

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

	* gnat_ugn.texi: Minor spelling correction.
	* makeutl.adb: Minor code reorganization.
	* exp_ch4.adb, exp_aggr.adb, exp_ch3.adb: Minor reformatting.

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

	* einfo.ads (Has_Unchecked_Union): Document that this is used
	to check for illegal Valid_Scalars attribute references.
	* exp_attr.adb (Build_Record_VS_Func): New function
	(Expand_N_Attribute_Reference, case Valid_Scalars): Call this
	function.
	* gnat_rm.texi: Document 'Valid_Scalars cannot be applied to
	Unchecked_Union Add note on 'Valid_Scalars generating a lot
	of code.
	* sem_attr.adb (Analyze_Attribute, case Valid_Scalars): Give
	error on attempt to apply Valid_Scalars to Unchecked_Union type.

From-SVN: r213298

10 files changed, 398 insertions, 73 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e6c0b06..54452ab 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2014-07-30  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_ugn.texi: Minor spelling correction.
+	* makeutl.adb: Minor code reorganization.
+	* exp_ch4.adb, exp_aggr.adb, exp_ch3.adb: Minor reformatting.
+
+2014-07-30  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads (Has_Unchecked_Union): Document that this is used
+	to check for illegal Valid_Scalars attribute references.
+	* exp_attr.adb (Build_Record_VS_Func): New function
+	(Expand_N_Attribute_Reference, case Valid_Scalars): Call this
+	function.
+	* gnat_rm.texi: Document 'Valid_Scalars cannot be applied to
+	Unchecked_Union Add note on 'Valid_Scalars generating a lot
+	of code.
+	* sem_attr.adb (Analyze_Attribute, case Valid_Scalars): Give
+	error on attempt to apply Valid_Scalars to Unchecked_Union type.
+
 2014-07-30  Steve Baird  <baird@adacore.com>
 
 	* exp_ch4.adb (Expand_N_Indexed_Component): Disable optimized handling
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6969bf8..ba96f04 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1955,9 +1955,9 @@ package Einfo is
 --       Defined in all type entities. Set on unchecked unions themselves
 --       and (recursively) on any composite type which has a component for
 --       which Has_Unchecked_Union is set. The meaning is that a comparison
---       operation for the type is not permitted. Note that the flag is not
---       set on access types, even if they designate an object that has
---       the flag Has_Unchecked_Union set.
+--       operation or 'Valid_Scalars reference for the type is not permitted.
+--       Note that the flag is not set on access types, even if they designate
+--       an object that has the flag Has_Unchecked_Union set.
 
 --    Has_Unknown_Discriminants (Flag72)
 --       Defined in all entities. Set for types with unknown discriminants.
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a43be85..9dd983c 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2847,12 +2847,11 @@ package body Exp_Aggr is
                   then
                      declare
                         Assoc : constant Node_Id :=
-                           First (Component_Associations (Expr_Q));
+                                  First (Component_Associations (Expr_Q));
                         Decl  : Node_Id;
 
                      begin
-                        if
-                          Nkind (First (Choices (Assoc))) = N_Others_Choice
+                        if Nkind (First (Choices (Assoc))) = N_Others_Choice
                         then
                            Decl :=
                              Build_Actual_Subtype_Of_Component
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 43051fa..9bdf92f 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -84,6 +84,14 @@ package body Exp_Attr is
    --  value returned is the entity of the constructed function body. We do not
    --  bother to generate a separate spec for this subprogram.
 
+   function Build_Record_VS_Func
+     (R_Type : Entity_Id;
+      Nod    : Node_Id) return Entity_Id;
+   --  Build function to test Valid_Scalars for record type A_Type. Nod is the
+   --  Valid_Scalars attribute node, used to insert the function body, and the
+   --  value returned is the entity of the constructed function body. We do not
+   --  bother to generate a separate spec for this subprogram.
+
    procedure Compile_Stream_Body_In_Scope
      (N     : Node_Id;
       Decl  : Node_Id;
@@ -202,10 +210,10 @@ package body Exp_Attr is
       Nod    : Node_Id) return Entity_Id
    is
       Loc        : constant Source_Ptr := Sloc (Nod);
+      Func_Id    : constant Entity_Id  := Make_Temporary (Loc, 'V');
       Comp_Type  : constant Entity_Id  := Component_Type (A_Type);
       Body_Stmts : List_Id;
       Index_List : List_Id;
-      Func_Id    : Entity_Id;
       Formals    : List_Id;
 
       function Test_Component return List_Id;
@@ -298,8 +306,6 @@ package body Exp_Attr is
 
    begin
       Index_List := New_List;
-      Func_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('V'));
-
       Body_Stmts := Test_One_Dimension (1);
 
       --  Parameter is always (A : A_Typ)
@@ -333,9 +339,279 @@ package body Exp_Attr is
          Set_Debug_Info_Off (Func_Id);
       end if;
 
+      Set_Is_Pure (Func_Id);
       return Func_Id;
    end Build_Array_VS_Func;
 
+   --------------------------
+   -- Build_Record_VS_Func --
+   --------------------------
+
+   --  Generates:
+
+   --    function _Valid_Scalars (X : T) return Boolean is
+   --    begin
+   --       --  Check discriminants
+
+   --       if not X.D1'Valid_Scalars or else
+   --          not X.D2'Valid_Scalars or else
+   --         ...
+   --       then
+   --          return False;
+   --       end if;
+
+   --       --  Check components
+
+   --       if not X.C1'Valid_Scalars or else
+   --          not X.C2'Valid_Scalars or else
+   --          ...
+   --       then
+   --          return False;
+   --       end if;
+
+   --       --  Check variant part
+
+   --       case X.D1 is
+   --          when V1 =>
+   --             if not X.C2'Valid_Scalars or else
+   --                not X.C3'Valid_Scalars or else
+   --               ...
+   --             then
+   --                return False;
+   --             end if;
+   --          ...
+   --          when Vn =>
+   --             if not X.Cn'Valid_Scalars or else
+   --               ...
+   --             then
+   --                return False;
+   --             end if;
+   --       end case;
+
+   --       return True;
+   --    end _Valid_Scalars;
+
+   function Build_Record_VS_Func
+     (R_Type : Entity_Id;
+      Nod    : Node_Id) return Entity_Id
+   is
+      Loc     : constant Source_Ptr := Sloc (R_Type);
+      Func_Id : constant Entity_Id  := Make_Temporary (Loc, 'V');
+      X       : constant Entity_Id  := Make_Defining_Identifier (Loc, Name_X);
+
+      function Make_VS_Case
+        (E      : Entity_Id;
+         CL     : Node_Id;
+         Discrs : Elist_Id := New_Elmt_List) return List_Id;
+      --  Building block for variant valid scalars. Given a Component_List node
+      --  CL, it generates an 'if' followed by a 'case' statement that compares
+      --  all components of local temporaries named X and Y (that are declared
+      --  as formals at some upper level). E provides the Sloc to be used for
+      --  the generated code.
+
+      function Make_VS_If
+        (E : Entity_Id;
+         L : List_Id) return Node_Id;
+      --  Building block for variant validate scalars. Given the list, L, of
+      --  components (or discriminants) L, it generates a return statement that
+      --  compares all components of local temporaries named X and Y (that are
+      --  declared as formals at some upper level). E provides the Sloc to be
+      --  used for the generated code.
+
+      ------------------
+      -- Make_VS_Case --
+      ------------------
+
+      --  <Make_VS_If on shared components>
+
+      --  case X.D1 is
+      --     when V1 => <Make_VS_Case> on subcomponents
+      --     ...
+      --     when Vn => <Make_VS_Case> on subcomponents
+      --  end case;
+
+      function Make_VS_Case
+        (E      : Entity_Id;
+         CL     : Node_Id;
+         Discrs : Elist_Id := New_Elmt_List) return List_Id
+      is
+         Loc      : constant Source_Ptr := Sloc (E);
+         Result   : constant List_Id    := New_List;
+         Variant  : Node_Id;
+         Alt_List : List_Id;
+
+      begin
+         Append_To (Result, Make_VS_If (E, Component_Items (CL)));
+
+         if No (Variant_Part (CL)) then
+            return Result;
+         end if;
+
+         Variant := First_Non_Pragma (Variants (Variant_Part (CL)));
+
+         if No (Variant) then
+            return Result;
+         end if;
+
+         Alt_List := New_List;
+         while Present (Variant) loop
+            Append_To (Alt_List,
+              Make_Case_Statement_Alternative (Loc,
+                Discrete_Choices => New_Copy_List (Discrete_Choices (Variant)),
+                Statements =>
+                  Make_VS_Case (E, Component_List (Variant), Discrs)));
+            Next_Non_Pragma (Variant);
+         end loop;
+
+         Append_To (Result,
+           Make_Case_Statement (Loc,
+             Expression =>
+               Make_Selected_Component (Loc,
+                 Prefix        => Make_Identifier (Loc, Name_X),
+                 Selector_Name => New_Copy (Name (Variant_Part (CL)))),
+             Alternatives => Alt_List));
+
+         return Result;
+      end Make_VS_Case;
+
+      ----------------
+      -- Make_VS_If --
+      ----------------
+
+      --  Generates:
+
+      --    if
+      --      not X.C1'Valid_Scalars
+      --        or else
+      --      not X.C2'Valid_Scalars
+      --        ...
+      --    then
+      --       return False;
+      --    end if;
+
+      --  or a null statement if the list L is empty
+
+      function Make_VS_If
+        (E : Entity_Id;
+         L : List_Id) return Node_Id
+      is
+         Loc        : constant Source_Ptr := Sloc (E);
+         C          : Node_Id;
+         Def_Id     : Entity_Id;
+         Field_Name : Name_Id;
+         Cond       : Node_Id;
+
+      begin
+         if No (L) then
+            return Make_Null_Statement (Loc);
+
+         else
+            Cond := Empty;
+
+            C := First_Non_Pragma (L);
+            while Present (C) loop
+               Def_Id := Defining_Identifier (C);
+               Field_Name := Chars (Def_Id);
+
+               --  The tags need not be checked since they will always be valid
+
+               --  Note also that in the following, we use Make_Identifier for
+               --  the component names. Use of New_Occurrence_Of to identify
+               --  the components would be incorrect because wrong entities for
+               --  discriminants could be picked up in the private type case.
+
+               --  Don't bother with abstract parent in interface case
+
+               if Field_Name = Name_uParent
+                 and then Is_Interface (Etype (Def_Id))
+               then
+                  null;
+
+               --  Don't bother with tag, always valid, and not scalar anyway
+
+               elsif Field_Name = Name_uTag then
+                  null;
+
+               --  Don't bother with component with no scalar components
+
+               elsif not Scalar_Part_Present (Etype (Def_Id)) then
+                  null;
+
+               --  Normal case, generate Valid_Scalars attribute reference
+
+               else
+                  Evolve_Or_Else (Cond,
+                    Make_Op_Not (Loc,
+                      Right_Opnd =>
+                        Make_Attribute_Reference (Loc,
+                          Prefix =>
+                            Make_Selected_Component (Loc,
+                              Prefix        =>
+                                Make_Identifier (Loc, Name_X),
+                              Selector_Name =>
+                                Make_Identifier (Loc, Field_Name)),
+                          Attribute_Name => Name_Valid_Scalars)));
+               end if;
+
+               Next_Non_Pragma (C);
+            end loop;
+
+            if No (Cond) then
+               return Make_Null_Statement (Loc);
+
+            else
+               return
+                 Make_Implicit_If_Statement (E,
+                   Condition       => Cond,
+                   Then_Statements => New_List (
+                     Make_Simple_Return_Statement (Loc,
+                       Expression =>
+                         New_Occurrence_Of (Standard_False, Loc))));
+            end if;
+         end if;
+      end Make_VS_If;
+
+      --  Local Declarations
+
+      Def    : constant Node_Id := Parent (R_Type);
+      Comps  : constant Node_Id := Component_List (Type_Definition (Def));
+      Stmts  : constant List_Id := New_List;
+      Pspecs : constant List_Id := New_List;
+
+   begin
+      Append_To (Pspecs,
+        Make_Parameter_Specification (Loc,
+          Defining_Identifier => X,
+          Parameter_Type      => New_Occurrence_Of (R_Type, Loc)));
+
+      Append_To (Stmts,
+        Make_VS_If (R_Type, Discriminant_Specifications (Def)));
+      Append_List_To (Stmts, Make_VS_Case (R_Type, Comps));
+
+      Append_To (Stmts,
+        Make_Simple_Return_Statement (Loc,
+          Expression => New_Occurrence_Of (Standard_True, Loc)));
+
+      Insert_Action (Nod,
+        Make_Subprogram_Body (Loc,
+          Specification =>
+            Make_Function_Specification (Loc,
+              Defining_Unit_Name       => Func_Id,
+              Parameter_Specifications => Pspecs,
+              Result_Definition => New_Occurrence_Of (Standard_Boolean, Loc)),
+          Declarations               => New_List,
+          Handled_Statement_Sequence =>
+            Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)),
+        Suppress => Discriminant_Check);
+
+      if not Debug_Generated_Code then
+         Set_Debug_Info_Off (Func_Id);
+      end if;
+
+      Set_Is_Pure (Func_Id);
+      return Func_Id;
+   end Build_Record_VS_Func;
+
    ----------------------------------
    -- Compile_Stream_Body_In_Scope --
    ----------------------------------
@@ -6377,14 +6653,18 @@ package body Exp_Attr is
             Ftyp := Ptyp;
          end if;
 
+         --  Replace by True if no scalar parts
+
+         if not Scalar_Part_Present (Ftyp) then
+            Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
+
          --  For scalar types, Valid_Scalars is the same as Valid
 
-         if Is_Scalar_Type (Ftyp) then
+         elsif Is_Scalar_Type (Ftyp) then
             Rewrite (N,
               Make_Attribute_Reference (Loc,
                 Attribute_Name => Name_Valid,
                 Prefix         => Pref));
-            Analyze_And_Resolve (N, Standard_Boolean);
 
          --  For array types, we construct a function that determines if there
          --  are any non-valid scalar subcomponents, and call the function.
@@ -6399,14 +6679,25 @@ package body Exp_Attr is
                   New_Occurrence_Of (Build_Array_VS_Func (Ftyp, N), Loc),
                 Parameter_Associations => New_List (Pref)));
 
-            Analyze_And_Resolve (N, Standard_Boolean);
-
-         --  For record types, we build a big if expression, applying Valid or
-         --  Valid_Scalars as appropriate to all relevant components.
+         --  For record types, we construct a function that determines if there
+         --  are any non-valid scalar subcomponents, and call the function.
 
-         elsif (Is_Record_Type (Ptyp) or else Has_Discriminants (Ptyp))
-           and then Scalar_Part_Present (Ptyp)
+         elsif Is_Record_Type (Ftyp)
+            and then Nkind (Type_Definition (Declaration_Node (Ftyp))) =
+                                                        N_Record_Definition
          then
+            Rewrite (N,
+              Make_Function_Call (Loc,
+                Name                   =>
+                  New_Occurrence_Of (Build_Record_VS_Func (Ftyp, N), Loc),
+              Parameter_Associations => New_List (Pref)));
+
+         --  Other record types or types with discriminants
+
+         elsif Is_Record_Type (Ftyp) or else Has_Discriminants (Ptyp) then
+
+            --  Build expression with list of equality tests
+
             declare
                C : Entity_Id;
                X : Node_Id;
@@ -6441,16 +6732,18 @@ package body Exp_Attr is
                end loop;
 
                Rewrite (N, X);
-               Analyze_And_Resolve (N, Standard_Boolean);
             end;
 
-         --  For all other types, result is True (but not static)
+         --  For all other types, result is True
 
          else
             Rewrite (N, New_Occurrence_Of (Standard_Boolean, Loc));
-            Analyze_And_Resolve (N, Standard_Boolean);
-            Set_Is_Static_Expression (N, False);
          end if;
+
+         --  Result is always boolean, but never static
+
+         Analyze_And_Resolve (N, Standard_Boolean);
+         Set_Is_Static_Expression (N, False);
       end Valid_Scalars;
 
       -----------
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index c928247..6533db2 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -147,7 +147,7 @@ package body Exp_Ch3 is
    --  The resulting operation is a TSS subprogram.
 
    procedure Build_Variant_Record_Equality (Typ  : Entity_Id);
-   --  Create An Equality function for the non-tagged variant record 'Typ'
+   --  Create An Equality function for the non-tagged variant record Typ
    --  and attach it to the TSS list
 
    procedure Check_Stream_Attributes (Typ : Entity_Id);
@@ -442,9 +442,7 @@ package body Exp_Ch3 is
 
          Ctyp := Etype (Comp);
 
-         if not Is_Array_Type (Ctyp)
-           or else Number_Dimensions (Ctyp) > 1
-         then
+         if not Is_Array_Type (Ctyp) or else Number_Dimensions (Ctyp) > 1 then
             goto Continue;
          end if;
 
@@ -4279,9 +4277,9 @@ package body Exp_Ch3 is
       end if;
    end Build_Untagged_Equality;
 
-   ------------------------------------
+   -----------------------------------
    -- Build_Variant_Record_Equality --
-   ------------------------------------
+   -----------------------------------
 
    --  Generates:
 
@@ -4289,13 +4287,13 @@ package body Exp_Ch3 is
    --    begin
    --       --  Compare discriminants
 
-   --       if False or else X.D1 /= Y.D1 or else X.D2 /= Y.D2 then
+   --       if X.D1 /= Y.D1 or else X.D2 /= Y.D2 or else ... then
    --          return False;
    --       end if;
 
    --       --  Compare components
 
-   --       if False or else X.C1 /= Y.C1 or else X.C2 /= Y.C2 then
+   --       if X.C1 /= Y.C1 or else X.C2 /= Y.C2 or else ... then
    --          return False;
    --       end if;
 
@@ -4303,12 +4301,12 @@ package body Exp_Ch3 is
 
    --       case X.D1 is
    --          when V1 =>
-   --             if False or else X.C2 /= Y.C2 or else X.C3 /= Y.C3 then
+   --             if X.C2 /= Y.C2 or else X.C3 /= Y.C3 or else ... then
    --                return False;
    --             end if;
    --          ...
    --          when Vn =>
-   --             if False or else X.Cn /= Y.Cn then
+   --             if X.Cn /= Y.Cn or else ... then
    --                return False;
    --             end if;
    --       end case;
@@ -4323,13 +4321,8 @@ package body Exp_Ch3 is
             Make_Defining_Identifier (Loc,
               Chars => Make_TSS_Name (Typ, TSS_Composite_Equality));
 
-      X : constant Entity_Id :=
-           Make_Defining_Identifier (Loc,
-             Chars => Name_X);
-
-      Y : constant Entity_Id :=
-            Make_Defining_Identifier (Loc,
-              Chars => Name_Y);
+      X : constant Entity_Id := Make_Defining_Identifier (Loc, Name_X);
+      Y : constant Entity_Id := Make_Defining_Identifier (Loc, Name_Y);
 
       Def    : constant Node_Id := Parent (Typ);
       Comps  : constant Node_Id := Component_List (Type_Definition (Def));
@@ -4357,7 +4350,6 @@ package body Exp_Ch3 is
          declare
             Parent_Eq : constant Entity_Id :=
                           TSS (Root_Type (Typ), TSS_Composite_Equality);
-
          begin
             if Present (Parent_Eq) then
                Copy_TSS (Parent_Eq, Typ);
@@ -8805,6 +8797,7 @@ package body Exp_Ch3 is
    ------------------
 
    --  <Make_Eq_If shared components>
+
    --  case X.D1 is
    --     when V1 => <Make_Eq_Case> on subcomponents
    --     ...
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 25f5de3..1fb35c1 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6164,11 +6164,15 @@ package body Exp_Ch4 is
       --  messing especially in the packed case, but more importantly bypasses
       --  some problems in handling this peculiar case, for example, the issue
       --  of dealing specially with object renamings.
-      --  This optimization is disabled for CodePeer because it can transform
-      --  an index-check constraint_error into a range-check constraint_error
-      --  and CodePeer cares about that distinction.
 
-      if Nkind (P) = N_Slice and then not CodePeer_Mode then
+      if Nkind (P) = N_Slice
+
+        --  This optimization is disabled for CodePeer because it can transform
+        --  an index-check constraint_error into a range-check constraint_error
+        --  and CodePeer cares about that distinction.
+
+        and then not CodePeer_Mode
+      then
          Rewrite (N,
            Make_Indexed_Component (Loc,
              Prefix      => Prefix (P),
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index b0a018b..edbba0f 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -10163,6 +10163,16 @@ be determined at compile time that the prefix of the attribute has no
 scalar parts (e.g., if the prefix is of an access type, an interface type,
 an undiscriminated task type, or an undiscriminated protected type).
 
+For scalar types, @code{Valid_Scalars} is equivalent to @code{Valid}. The use
+of this attribute is not permitted for @code{Unchecked_Union} types for which
+in general it is not possible to determine the values of the discriminants.
+
+Note: @code{Valid_Scalars} can generate a lot of code, especially in the case
+of a large variant record. If the attribute is called in many places in the
+same program applied to objects of the same type, it can reduce program size
+to write a function with a single use of the attribute, and then call that
+function from multiple places.
+
 @node Attribute VADS_Size
 @unnumberedsec Attribute VADS_Size
 @cindex @code{Size}, VADS compatibility
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 5984097..6ba7002 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19972,7 +19972,7 @@ by hand.
 
 @item --omit-sloc
 @cindex @option{--omit-sloc} (@command{gnattest})
-Supresses comment line containing file name and line number of corresponding
+Suppresses comment line containing file name and line number of corresponding
 subprograms in test skeletons.
 
 @end table
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 7611106..b192ef8 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -2912,26 +2912,26 @@ package body Makeutl is
       is
 
          procedure Do_Insert
-           (Project    : Project_Id;
-            Tree       : Project_Tree_Ref;
-            Context    : Project_Context);
+           (Project : Project_Id;
+            Tree    : Project_Tree_Ref;
+            Context : Project_Context);
+         --  Local procedures must be commented ???
 
          ---------------
          -- Do_Insert --
          ---------------
 
          procedure Do_Insert
-           (Project    : Project_Id;
-            Tree       : Project_Tree_Ref;
-            Context    : Project_Context)
+           (Project : Project_Id;
+            Tree    : Project_Tree_Ref;
+            Context : Project_Context)
          is
             Unit_Based : constant Boolean :=
                            Unique_Compile
                              or else not Builder_Data (Tree).Closure_Needed;
-            --  When Unit_Based is True, put in the queue all compilable
-            --  sources including the unit based (Ada) one. When Unit_Based is
-            --  False, put the Ada sources only when they are in a library
-            --  project.
+            --  When Unit_Based is True, we enqueue all compilable sources
+            --  including the unit based (Ada) one. When Unit_Based is False,
+            --  put the Ada sources only when they are in a library project.
 
             Iter    : Source_Iterator;
             Source  : Prj.Source_Id;
@@ -2942,9 +2942,7 @@ package body Makeutl is
             --  Nothing to do when "-u" was specified and some files were
             --  specified on the command line
 
-            if Unique_Compile
-              and then Mains.Number_Of_Mains (Tree) > 0
-            then
+            if Unique_Compile and then Mains.Number_Of_Mains (Tree) > 0 then
                return;
             end if;
 
@@ -2955,16 +2953,13 @@ package body Makeutl is
 
                if Is_Allowed_Language (Source.Language.Name)
                  and then Is_Compilable (Source)
-                 and then
-                   (All_Projects
-                     or else Is_Extending (Project, Source.Project))
+                 and then (All_Projects
+                            or else Is_Extending (Project, Source.Project))
                  and then not Source.Locally_Removed
                  and then Source.Replaced_By = No_Source
-                 and then
-                   (not Source.Project.Externally_Built
-                     or else
-                       (Is_Extending (Project, Source.Project)
-                         and then not Project.Externally_Built))
+                 and then (not Source.Project.Externally_Built
+                            or else (Is_Extending (Project, Source.Project)
+                                      and then not Project.Externally_Built))
                  and then Source.Kind /= Sep
                  and then Source.Path /= No_Path_Information
                then
@@ -2988,19 +2983,20 @@ package body Makeutl is
                         if Source.Unit /= No_Unit_Index
                           and then
                             (Source.Project.Library
-                             or else Project.Qualifier = Aggregate_Library
-                             or else Context.In_Aggregate_Lib)
+                              or else Project.Qualifier = Aggregate_Library
+                              or else Context.In_Aggregate_Lib)
                           and then Source.Project.Standalone_Library /= No
                         then
                            --  Check if the unit is in the interface
+
                            OK := False;
 
                            declare
-                              List : String_List_Id :=
-                                Source.Project.Lib_Interface_ALIs;
+                              List    : String_List_Id;
                               Element : String_Element;
 
                            begin
+                              List := Source.Project.Lib_Interface_ALIs;
                               while List /= Nil_String loop
                                  Element :=
                                    Project_Tree.Shared.String_Elements.Table
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index b9a0fa6..88c3c5d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6589,12 +6589,23 @@ package body Sem_Attr is
       when Attribute_Valid_Scalars =>
          Check_E0;
          Check_Object_Reference (P);
+         Set_Etype (N, Standard_Boolean);
 
-         if not Scalar_Part_Present (P_Type) then
-            Error_Attr_P ("??attribute % always True, no scalars to check");
-         end if;
+         --  Following checks are only for source types
 
-         Set_Etype (N, Standard_Boolean);
+         if Comes_From_Source (N) then
+            if not Scalar_Part_Present (P_Type) then
+               Error_Attr_P
+                 ("??attribute % always True, no scalars to check");
+            end if;
+
+            --  Not allowed for unchecked union type
+
+            if Has_Unchecked_Union (P_Type) then
+               Error_Attr_P
+                 ("attribute % not allowed for Unchecked_Union type");
+            end if;
+         end if;
 
       -----------
       -- Value --