From 268aeaa9023ec4e0d7770cbe1b9b4fd99374c2fa Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 20 Apr 2016 12:51:01 +0200 Subject: [PATCH] [multiple changes] 2016-04-20 Hristian Kirtchev * exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting. 2016-04-20 Ed Schonberg * exp_unst.adb (Check_Static_Type): For a private type, check full view. 2016-04-20 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/exp_unst.adb | 9 +++++++++ gcc/ada/exp_util.adb | 5 ++--- gcc/ada/freeze.adb | 1 - gcc/ada/sem_attr.adb | 45 ++++++++++++++++++++++++++++++++++++++++---- gcc/ada/sem_util.adb | 5 +++-- 6 files changed, 70 insertions(+), 10 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e62507ee3a0..81bc2cc5db1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2016-04-20 Hristian Kirtchev + + * exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting. + +2016-04-20 Ed Schonberg + + * exp_unst.adb (Check_Static_Type): For a private type, check + full view. + +2016-04-20 Ed Schonberg + + * 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 * 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 63516330807..12204d86c76 100644 --- 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 0c13befd92b..da9ed388521 100644 --- 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 0ea2e1fdd82..572b194e687 100644 --- 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 1d220c543d3..e8483b9eebd 100644 --- 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 eb3eed56991..ac4e8c2a39a 100644 --- 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; -- 2.30.2