diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 36 | ||||
| -rw-r--r-- | gcc/ada/atree.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 99 | ||||
| -rw-r--r-- | gcc/ada/exp_util.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-env.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 2 |
11 files changed, 193 insertions, 26 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2126995..92b8355 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2014-02-19 Yannick Moy <moy@adacore.com> + + * sinfo.ads: Minor comment update. + +2014-02-19 Hristian Kirtchev <kirtchev@adacore.com> + + * atree.ads: Minor reformatting (change Entity_Info to Einfo). + +2014-02-19 Thomas Quinot <quinot@adacore.com> + + * exp_ch7.adb (Find_Node_To_Be_Wrapped): An assignment statement + that has the No_Ctrl_Actions flag is a suitable node to be + wrapped if the assigned expression has no finalization actions. + * sem_eval.adb (Eval_Entity_Name): For a compile time known + boolean value, mark the corresponding condition SCO as constant. + +2014-02-19 Robert Dewar <dewar@adacore.com> + + * exp_util.adb: Minor reformatting. + * exp_util.ads (Matching_Standard_Type): New function. + * exp_ch7.adb: Minor reformatting. + +2014-02-19 Ed Schonberg <schonberg@adacore.com> + + * sem_ch13.adb (Get_Cursor_Type): Use scope of iterable type + to find declaration for Cursor, to handle properly the case of + a discriminated iterable type. + +2014-02-19 Vincent Celier <celier@adacore.com> + + * gnatcmd.adb (GNATCmd): Always replace the object dirs of + imported library projects with the library ALI dirs, when setting + the object paths. + * prj-env.ads (Ada_Objects_Path): Correct comments about + argument Including_Libraries. + 2014-02-19 Gary Dismukes <dismukes@adacore.com> * gnat_rm.texi: Minor spelling fixes. diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index b167d8f..0603d11 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -47,18 +47,17 @@ package Atree is -- program internally. Syntactic and semantic information is combined in -- this tree. There is no separate symbol table structure. --- WARNING: There is a C version of this package. Any changes to this --- source file must be properly reflected in the C header file atree.h +-- WARNING: There is a C version of this package. Any changes to this source +-- file must be properly reflected in the C header file atree.h -- Package Atree defines the basic structure of the tree and its nodes and --- provides the basic abstract interface for manipulating the tree. Two --- other packages use this interface to define the representation of Ada --- programs using this tree format. The package Sinfo defines the basic --- representation of the syntactic structure of the program, as output --- by the parser. The package Entity_Info defines the semantic information --- which is added to the tree nodes that represent declared entities (i.e. --- the information which might typically be described in a separate symbol --- table structure). +-- provides the basic abstract interface for manipulating the tree. Two other +-- packages use this interface to define the representation of Ada programs +-- using this tree format. The package Sinfo defines the basic representation +-- of the syntactic structure of the program, as output by the parser. The +-- package Einfo defines the semantic information which is added to the tree +-- nodes that represent declared entities (i.e. the information which might +-- typically be described in a separate symbol table structure). -- The front end of the compiler first parses the program and generates a -- tree that is simply a syntactic representation of the program in abstract diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 822f689..79b609d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4184,10 +4184,15 @@ package body Exp_Ch7 is -- Usually assignments are good candidate for wrapping except -- when they have been generated as part of a controlled aggregate - -- where the wrapping should take place more globally. + -- where the wrapping should take place more globally. Note that + -- No_Ctrl_Actions may be set also for non-controlled assignements + -- in order to disable the use of dispatching _assign, so we need + -- to test explicitly for a controlled type here. when N_Assignment_Statement => - if No_Ctrl_Actions (The_Parent) then + if No_Ctrl_Actions (The_Parent) + and then Needs_Finalization (Etype (Name (The_Parent))) + then null; else return The_Parent; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b3f6c19..27559d7 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3950,6 +3950,43 @@ package body Exp_Util is end if; end Insert_Actions_After; + ------------------------ + -- Insert_Declaration -- + ------------------------ + + procedure Insert_Declaration (N : Node_Id; Decl : Node_Id) is + P : Node_Id; + + begin + pragma Assert (Nkind (N) in N_Subexpr); + + -- Climb until we find a procedure or a package + + P := Parent (N); + loop + if Is_List_Member (P) then + exit when Nkind_In (Parent (P), N_Package_Specification, + N_Package_Body, + N_Subprogram_Body); + + -- Special handling for handled sequence of statements, we must + -- insert in the statements not the exception handlers! + + if Nkind (Parent (P)) = N_Handled_Sequence_Of_Statements then + P := First (Statements (Parent (P))); + exit; + end if; + end if; + + P := Parent (P); + end loop; + + -- Now do the insertion + + Insert_Before (P, Decl); + Analyze (Decl); + end Insert_Declaration; + --------------------------------- -- Insert_Library_Level_Action -- --------------------------------- @@ -5924,6 +5961,68 @@ package body Exp_Util is Constraints => List_Constr)); end Make_Subtype_From_Expr; + ---------------------------- + -- Matching_Standard_Type -- + ---------------------------- + + function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id is + pragma Assert (Is_Scalar_Type (Typ)); + Siz : constant Uint := Esize (Typ); + + begin + -- Float-point cases + + if Is_Floating_Point_Type (Typ) then + if Siz <= Esize (Standard_Short_Float) then + return Standard_Short_Float; + elsif Siz <= Esize (Standard_Float) then + return Standard_Float; + elsif Siz <= Esize (Standard_Long_Float) then + return Standard_Long_Float; + elsif Siz <= Esize (Standard_Long_Long_Float) then + return Standard_Long_Long_Float; + else + raise Program_Error; + end if; + + -- Integer cases (includes fixed-point types) + + -- Unsigned cases (includes normal enumeration types) + + elsif Is_Unsigned_Type (Typ) then + if Siz <= Esize (Standard_Short_Short_Unsigned) then + return Standard_Short_Short_Unsigned; + elsif Siz <= Esize (Standard_Short_Unsigned) then + return Standard_Short_Unsigned; + elsif Siz <= Esize (Standard_Unsigned) then + return Standard_Unsigned; + elsif Siz <= Esize (Standard_Long_Unsigned) then + return Standard_Long_Unsigned; + elsif Siz <= Esize (Standard_Long_Long_Unsigned) then + return Standard_Long_Long_Unsigned; + else + raise Program_Error; + end if; + + -- Signed cases + + else + if Siz <= Esize (Standard_Short_Short_Integer) then + return Standard_Short_Short_Integer; + elsif Siz <= Esize (Standard_Short_Integer) then + return Standard_Short_Integer; + elsif Siz <= Esize (Standard_Integer) then + return Standard_Integer; + elsif Siz <= Esize (Standard_Long_Integer) then + return Standard_Long_Integer; + elsif Siz <= Esize (Standard_Long_Long_Integer) then + return Standard_Long_Long_Integer; + else + raise Program_Error; + end if; + end if; + end Matching_Standard_Type; + ----------------------------- -- May_Generate_Large_Temp -- ----------------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 808af98..f14117c 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -140,6 +140,18 @@ package Exp_Util is -- generalize to expressions if there is a need but this is tricky to -- implement because of short-circuits (among other things).??? + procedure Insert_Declaration (N : Node_Id; Decl : Node_Id); + -- N must be a subexpression (Nkind in N_Subexpr). This is similar to + -- Insert_Action (N, Decl), but inserts Decl outside the expression in + -- which N appears. This is called Insert_Declaration because the intended + -- use is for declarations that have no associated code. We can't go + -- moving other kinds of things out of the current expression, since they + -- could be executed conditionally (e.g. right operand of short circuit, + -- or THEN/ELSE of if expression). This is currently used only in + -- Modify_Tree_For_C mode, where it is needed because in C we have no + -- way of having declarations within an expression (a really annoying + -- limitation). + procedure Insert_Library_Level_Action (N : Node_Id); -- This procedure inserts and analyzes the node N as an action at the -- library level for the current unit (i.e. it is attached to the @@ -678,6 +690,12 @@ package Exp_Util is -- expression E. Unc_Typ is an unconstrained array or record, or -- a classwide type. + function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id; + -- Given a scalar subtype Typ, returns a matching type in standard that + -- has the same object size value. For example, a 16 bit signed type will + -- typically return Standard_Short_Integer. For fixed-point types, this + -- will return integer types of the corresponding size. + function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean; -- Determines if the given type, Typ, may require a large temporary of the -- kind that causes back-end trouble if stack checking is enabled. The diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 1bca7d8..5d8a935 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1040,6 +1040,7 @@ procedure GNATCmd is "accept project file switches -vPx, -Pprj and -Xnam=val"); New_Line; end Non_VMS_Usage; + ------------------ -- Process_Link -- ------------------ @@ -2106,7 +2107,7 @@ begin -- Set up the env vars for project path files Prj.Env.Set_Ada_Paths - (Project, Project_Tree, Including_Libraries => False); + (Project, Project_Tree, Including_Libraries => True); -- For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create -- a configuration pragmas file, if necessary. diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 43bc578..0bb0eb1 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1681,8 +1681,6 @@ package body Prj.Env is Path : Path_Name_Type; begin - -- ??? This is almost the equivalent of For_All_Source_Dirs - if Process_Source_Dirs then -- Add to path all source directories of this project if there are diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 831ce8c..21239b4 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -92,7 +92,7 @@ package Prj.Env is Including_Libraries : Boolean := True) return String_Access; -- Get the ADA_OBJECTS_PATH of a Project file. For the first call with the -- exact same parameters, compute it and cache it. When Including_Libraries - -- is False, the object directory of a library project is replaced with the + -- is True, the object directory of a library project is replaced with the -- library ALI directory of this project (usually the library directory of -- the project, except when attribute Library_ALI_Dir is declared) except -- when the library ALI directory does not contain any ALI file. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 7e2a09c..7c4d266 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -128,9 +128,9 @@ package body Sem_Ch13 is -- Uint value. If the value is inappropriate, then error messages are -- posted as required, and a value of No_Uint is returned. - function Get_Cursor_Type return Entity_Id; - -- Find Cursor type by name in the current scope, used to resolve primitive - -- operations of an iterable type. + function Get_Cursor_Type (S : Entity_Id) return Entity_Id; + -- Find Cursor type by name in the scope of an iterable type, for use in + -- resolving the primitive operations of the type. function Is_Operational_Item (N : Node_Id) return Boolean; -- A specification for a stream attribute is allowed before the full type @@ -8059,7 +8059,7 @@ package body Sem_Ch13 is T := Entity (ASN); declare - Cursor : constant Entity_Id := Get_Cursor_Type; + Cursor : constant Entity_Id := Get_Cursor_Type (Scope (T)); Assoc : Node_Id; Expr : Node_Id; begin @@ -9749,7 +9749,7 @@ package body Sem_Ch13 is -- Get_Cursor_Type -- --------------------- - function Get_Cursor_Type return Entity_Id is + function Get_Cursor_Type (S : Entity_Id) return Entity_Id is C : Entity_Id; E : Entity_Id; @@ -9758,7 +9758,7 @@ package body Sem_Ch13 is -- used in iterable primitives. C := Empty; - E := First_Entity (Current_Scope); + E := First_Entity (S); while Present (E) loop if Chars (E) = Name_Cursor and then Is_Type (E) then C := E; @@ -11455,7 +11455,7 @@ package body Sem_Ch13 is Expr : Node_Id; Prim : Node_Id; - Cursor : constant Entity_Id := Get_Cursor_Type; + Cursor : constant Entity_Id := Get_Cursor_Type (Scope (Typ)); First_Id : Entity_Id; Next_Id : Entity_Id; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 4d69021..51b84f6 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -37,6 +37,7 @@ with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; with Opt; use Opt; +with Par_SCO; use Par_SCO; with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Aux; use Sem_Aux; @@ -1955,8 +1956,8 @@ package body Sem_Eval is elsif Ekind (Def_Id) = E_Constant then - -- Deferred constants must always be treated as nonstatic - -- outside the scope of their full view. + -- Deferred constants must always be treated as nonstatic outside the + -- scope of their full view. if Present (Full_View (Def_Id)) and then not In_Open_Scopes (Scope (Def_Id)) @@ -1978,6 +1979,16 @@ package body Sem_Eval is Validate_Static_Object_Name (N); end if; + -- Mark constant condition in SCOs + + if Generate_SCO + and then Comes_From_Source (N) + and then Is_Boolean_Type (Etype (Def_Id)) + and then Compile_Time_Known_Value (N) + then + Set_SCO_Condition (N, Expr_Value_E (N) = Standard_True); + end if; + return; end if; end if; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index b5769f8..cb8b0ee 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -550,7 +550,7 @@ package Sinfo is -- do not lead to data dependences for subprograms can be safely ignored. -- In addition pragma Debug statements are removed from the tree (rewritten - -- to NULL stmt), since they should be taken into account in flow analysis. + -- to NULL stmt), since they should be ignored in formal verification. -- An error is also issued for missing subunits, similar to the warning -- issued when generating code, to avoid formal verification of a partial |