[multiple changes]

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_unst.adb (Check_Static_Type): For a private type, check
	full view.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Check_Type): Reject an attribute reference in
	an aspect expression, when the prefix of the reference is the
	current instance of the type to which the aspect applies.

From-SVN: r235267

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e62507ee3a09447617440b7f934cc255b479f84e..81bc2cc5db1b6f3541634d49d29ad12936e2e8ca 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting.
+
+2016-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_unst.adb (Check_Static_Type): For a private type, check
+       full view.
+
+2016-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_attr.adb (Check_Type): Reject an attribute reference in
+       an aspect expression, when the prefix of the reference is the
+       current instance of the type to which the aspect applies.
+
 2016-04-20  Bob Duff  <duff@adacore.com>
 
        * sem_ch6.adb (Enter_Overloaded_Entity): Do not warn about

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 63516330807012d2d7e18d9322fb366959cee6b6..12204d86c768b904eff0ff22d1b188a57dacde1b 100644 (file)
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -448,6 +448,15 @@ package body Exp_Unst is
                      end loop;
                   end;
 
+               --  For private type, examine whether full view is static
+
+               elsif Is_Private_Type (T) and then Present (Full_View (T)) then
+                  Check_Static_Type (Full_View (T), DT);
+
+                  if Is_Static_Type (Full_View (T)) then
+                     Set_Is_Static_Type (T);
+                  end if;
+
                --  For now, ignore other types
 
                else

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0c13befd92b6e8c0963f7ee10a0ed29abd71337f..da9ed388521d1f09d43ffd958e20fd0d50acca72 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -924,8 +924,8 @@ package body Exp_Util is
    --------------------------
 
    procedure Build_Procedure_Form (N : Node_Id) is
-      Loc          : constant Source_Ptr := Sloc (N);
-      Subp         : constant Entity_Id := Defining_Entity (N);
+      Loc  : constant Source_Ptr := Sloc (N);
+      Subp : constant Entity_Id := Defining_Entity (N);
 
       Func_Formal  : Entity_Id;
       Proc_Formals : List_Id;
@@ -941,7 +941,6 @@ package body Exp_Util is
          Append_To (Proc_Formals,
            Make_Parameter_Specification (Loc,
              Defining_Identifier =>
-
                Make_Defining_Identifier (Loc, Chars (Func_Formal)),
              Parameter_Type      =>
                New_Occurrence_Of (Etype (Func_Formal), Loc)));

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 0ea2e1fdd823d1e6d452a919b4e101d7214012c6..572b194e6876032d90ed005a040ccbefb7f605c7 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7902,7 +7902,6 @@ package body Freeze is
       then
          Build_Procedure_Form (Unit_Declaration_Node (E));
       end if;
-
    end Freeze_Subprogram;
 
    ----------------------

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 1d220c543d367a9e0ee5f5711d8cbfec48642ae8..e8483b9eebdae94b08b6f605209c7307e710183b 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1408,10 +1408,41 @@ package body Sem_Attr is
       --------------------------------
 
       procedure Check_Array_Or_Scalar_Type is
+         function In_Aspect_Specification return Boolean;
+         --  A current instance of a type in an aspect specification is an
+         --  object and not a type, and therefore cannot be of a scalar type
+         --  in the prefix of one of the array attributes if the attribute
+         --  reference is part of an aspect expression.
+
+         -----------------------------
+         -- In_Aspect_Specification --
+         -----------------------------
+
+         function In_Aspect_Specification return Boolean is
+            P : Node_Id;
+
+         begin
+            P := Parent (N);
+            while Present (P) loop
+               if Nkind (P) = N_Aspect_Specification then
+                  return P_Type = Entity (P);
+
+               elsif Nkind (P) in N_Declaration then
+                  return False;
+               end if;
+
+               P := Parent (P);
+            end loop;
+
+            return False;
+         end In_Aspect_Specification;
+
+         --  Local variables
+
+         Dims  : Int;
          Index : Entity_Id;
 
-         D : Int;
-         --  Dimension number for array attributes
+      --  Start of processing for Check_Array_Or_Scalar_Type
 
       begin
          --  Case of string literal or string literal subtype. These cases
@@ -1431,6 +1462,12 @@ package body Sem_Attr is
 
             if Present (E1) then
                Error_Attr ("invalid argument in % attribute", E1);
+
+            elsif In_Aspect_Specification then
+               Error_Attr
+                 ("prefix of % attribute cannot be the current instance of a "
+                  & "scalar type", P);
+
             else
                Set_Etype (N, P_Base_Type);
                return;
@@ -1466,9 +1503,9 @@ package body Sem_Attr is
                Set_Etype (N, Base_Type (Etype (Index)));
 
             else
-               D := UI_To_Int (Intval (E1));
+               Dims := UI_To_Int (Intval (E1));
 
-               for J in 1 .. D - 1 loop
+               for J in 1 .. Dims - 1 loop
                   Next_Index (Index);
                end loop;
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index eb3eed569912220f8b633e8de5a3dfd9bb9c6c89..ac4e8c2a39a2eaa824f83c5e16d00935658a3f89 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14360,8 +14360,9 @@ package body Sem_Util is
                    and then Is_Predefined_File_Name
                               (Unit_File_Name (Get_Source_Unit (Par)));
             else
-               return Present (Alias (Id))
-                 and then Is_Unchecked_Conversion_Instance (Alias (Id));
+               return
+                 Present (Alias (Id))
+                   and then Is_Unchecked_Conversion_Instance (Alias (Id));
             end if;
          end if;
       end if;