From: Arnaud Charlet Date: Fri, 13 Jan 2017 10:08:46 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=582dbb53ac6d0bd46c1402584d2c4be0a34a040b;p=gcc.git [multiple changes] 2017-01-13 Justin Squirek * sem_ch12.adb (Analyze_Package_Instantiation): Move disabiling of the style check until after preanalysis of acutals. 2017-01-13 Yannick Moy * sem_ch13.adb: Minor reformatting. * par-ch11.adb: minor style fix in whitespace * gnatbind.adb (Gnatbind): Scope of Std_Lib_File reduced to Add_Artificial_ALI_File; style fix in declaration of Text; grammar fix in comment. * osint-c.adb (Read_Library_Info): strip trailing NUL from result. * freeze.adb: Cleanup to pass pragma instead of expression to call. * exp_spark.adb (Expand_SPARK_Attribute_Reference): New procedure to replace System'To_Address by equivalent call. From-SVN: r244401 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d4193950a4e..d851a51b4b7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2017-01-13 Justin Squirek + + * sem_ch12.adb (Analyze_Package_Instantiation): Move disabiling + of the style check until after preanalysis of acutals. + +2017-01-13 Yannick Moy + + * sem_ch13.adb: Minor reformatting. + * par-ch11.adb: minor style fix in whitespace + * gnatbind.adb (Gnatbind): Scope of Std_Lib_File + reduced to Add_Artificial_ALI_File; style fix in declaration of + Text; grammar fix in comment. + * osint-c.adb (Read_Library_Info): strip trailing NUL from result. + * freeze.adb: Cleanup to pass pragma instead of + expression to call. + * exp_spark.adb (Expand_SPARK_Attribute_Reference): New procedure to + replace System'To_Address by equivalent call. + 2017-01-13 Arnaud Charlet * bindusg.adb: Improve usage output for -f switch. diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index a0721f6b624..bd66d015afd 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -28,9 +28,14 @@ with Einfo; use Einfo; with Exp_Ch5; use Exp_Ch5; with Exp_Dbug; use Exp_Dbug; with Exp_Util; use Exp_Util; +with Namet; use Namet; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Rtsfind; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; +with Snames; use Snames; with Tbuild; use Tbuild; package body Exp_SPARK is @@ -39,6 +44,10 @@ package body Exp_SPARK is -- Local Subprograms -- ----------------------- + procedure Expand_SPARK_Attribute_Reference (N : Node_Id); + -- Replace occurrences of System'To_Address by calls to + -- System.Storage_Elements.To_Address + procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id); -- Perform name evaluation for a renamed object @@ -74,6 +83,12 @@ package body Exp_SPARK is when N_Object_Renaming_Declaration => Expand_SPARK_N_Object_Renaming_Declaration (N); + -- Replace occurrences of System'To_Address by calls to + -- System.Storage_Elements.To_Address + + when N_Attribute_Reference => + Expand_SPARK_Attribute_Reference (N); + -- Loop iterations over arrays need to be expanded, to avoid getting -- two names referring to the same object in memory (the array and -- the iterator) in GNATprove, especially since both can be written @@ -101,6 +116,42 @@ package body Exp_SPARK is end case; end Expand_SPARK; + -------------------------------------- + -- Expand_SPARK_Attribute_Reference -- + -------------------------------------- + + procedure Expand_SPARK_Attribute_Reference (N : Node_Id) is + Aname : constant Name_Id := Attribute_Name (N); + Attr_Id : constant Attribute_Id := Get_Attribute_Id (Aname); + Expr : Node_Id; + Call : Node_Id; + + begin + if Attr_Id = Attribute_To_Address then + -- Extract argument to later reanalyze it in the new context + + Expr := First (Expressions (N)); + Nlists.Remove (Expr); + Set_Etype (Expr, Empty); + Set_Analyzed (Expr, False); + + -- Create the call and insert it in the tree + + Call := Make_Function_Call (Sloc (N), + Name => New_Occurrence_Of + (Rtsfind.RTE (Rtsfind.RE_To_Address), Sloc (N)), + Parameter_Associations => + New_List (Expr)); + Set_Etype (Call, Etype (N)); + Rewrite (Old_Node => N, New_Node => Call); + + -- Reanalyze argument and call in the new context + + Analyze_And_Resolve (Expr, Rtsfind.RTE (Rtsfind.RE_Integer_Address)); + Analyze_And_Resolve (N, Etype (N)); + end if; + end Expand_SPARK_Attribute_Reference; + ------------------------------------------------ -- Expand_SPARK_N_Object_Renaming_Declaration -- ------------------------------------------------ diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5fae9fd5b15..8215a7602c3 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1455,9 +1455,6 @@ package body Freeze is A_Pre := Get_Pragma (Par_Prim, Pragma_Precondition); if Present (A_Pre) and then Class_Present (A_Pre) then - A_Pre := - Expression (First (Pragma_Argument_Associations (A_Pre))); - Build_Class_Wide_Expression (Prag => New_Copy_Tree (A_Pre), Subp => Prim, @@ -1468,9 +1465,6 @@ package body Freeze is A_Post := Get_Pragma (Par_Prim, Pragma_Postcondition); if Present (A_Post) and then Class_Present (A_Post) then - A_Post := - Expression (First (Pragma_Argument_Associations (A_Post))); - Build_Class_Wide_Expression (Prag => New_Copy_Tree (A_Post), Subp => Prim, diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 51353773822..8cd99cf8f75 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -69,10 +69,7 @@ procedure Gnatbind is -- The first library file, that should be a main subprogram if neither -n -- nor -z are used. - Std_Lib_File : File_Name_Type; - -- Standard library - - Text : Text_Buffer_Ptr; + Text : Text_Buffer_Ptr; Output_File_Name_Seen : Boolean := False; Output_File_Name : String_Ptr := new String'(""); @@ -124,6 +121,9 @@ procedure Gnatbind is Id : ALI_Id; pragma Warnings (Off, Id); + Std_Lib_File : File_Name_Type; + -- Standard library + begin Name_Len := Name'Length; Name_Buffer (1 .. Name_Len) := Name; @@ -769,7 +769,7 @@ begin -- Add System.Standard_Library to list to ensure that these files are -- included in the bind, even if not directly referenced from Ada code -- This is suppressed if the appropriate targparm switch is set. Be sure - -- in any case that System is in the closure, as it may contains linker + -- in any case that System is in the closure, as it may contain linker -- options. Note that it will be automatically added if s-stalib is -- added. diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 919f188a8e4..28abc609030 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -347,6 +347,13 @@ package body Osint.C is is begin Set_File_Name (ALI_Suffix.all); + + -- Remove trailing NUL that comes from Set_File_Name above. This is + -- needed for consistency with names that come from Scan_ALI and thus + -- preventing repeated scanning of the same file. + pragma Assert (Name_Len > 1 and then Name_Buffer (Name_Len) = ASCII.NUL); + Name_Len := Name_Len - 1; + Name := Name_Find; Text := Read_Library_Info (Name, Fatal_Err => False); end Read_Library_Info; diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb index 61df3ee2512..6c954b1edf9 100644 --- a/gcc/ada/par-ch11.adb +++ b/gcc/ada/par-ch11.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -34,8 +34,8 @@ package body Ch11 is -- Local functions, used only in this chapter - function P_Exception_Handler return Node_Id; - function P_Exception_Choice return Node_Id; + function P_Exception_Handler return Node_Id; + function P_Exception_Choice return Node_Id; --------------------------------- -- 11.1 Exception Declaration -- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 185310f66db..2a5e66002ea 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3686,12 +3686,6 @@ package body Sem_Ch12 is Instantiation_Node := N; - -- Turn off style checking in instances. If the check is enabled on the - -- generic unit, a warning in an instance would just be noise. If not - -- enabled on the generic, then a warning in an instance is just wrong. - - Style_Check := False; - -- Case of instantiation of a generic package if Nkind (N) = N_Package_Instantiation then @@ -3724,6 +3718,12 @@ package body Sem_Ch12 is Preanalyze_Actuals (N, Act_Decl_Id); + -- Turn off style checking in instances. If the check is enabled on the + -- generic unit, a warning in an instance would just be noise. If not + -- enabled on the generic, then a warning in an instance is just wrong. + + Style_Check := False; + Init_Env; Env_Installed := True; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9d3f8c64d6b..b4319f11fe1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11603,12 +11603,11 @@ package body Sem_Ch13 is function Is_Type_Ref (N : Node_Id) return Boolean; pragma Inline (Is_Type_Ref); - -- Returns True if N is a reference to the type for the predicate in the -- expression (i.e. if it is an identifier whose Chars field matches the -- Nam given in the call). N must not be parenthesized, if the type name -- appears in parens, this routine will return False. - + -- -- The routine also returns True for function calls generated during the -- expansion of comparison operators on strings, which are intended to -- be legal in static predicates, and are converted into calls to array