+2016-10-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch10.adb (Entity_Needs_Body): A generic
+ subprogram renaming needs a body if the renamed unit is declared
+ outside the current compilation unit.
+
+2016-10-13 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sinfo.ads, sem_ch12.adb, sem.adb, expander.adb, sem_res.ads,
+ sem_ch4.adb, sem_ch8.adb, s-memory.adb: Minor reformatting.
+
+2016-10-13 Vincent Celier <celier@adacore.com>
+
+ * gnatcmd.adb: Delete all temporary files when invoked as gnat
+ list -V -P ...
+
+2016-10-13 Ed Falis <falis@adacore.com>
+
+ * impunit.adb: add i-vxinco.ads.
+ * s-interr-vxworks.adb: add hook for user interrupt connection routine.
+
2016-10-13 Ed Falis <falis@adacore.com>
* s-interr-hwint.adb, s-interr-vxworks.adb: Rename s-interr-hwint.adb
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, 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- --
-- corresponding expand routines.
case Nkind (N) is
-
when N_Abort_Statement =>
Expand_N_Abort_Statement (N);
if Add_Sources then
Tempdir.Create_Temp_File (FD, Temp_File_Name);
+ Record_Temp_File (Project_Tree.Shared, Temp_File_Name);
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'("-files=" & Get_Name_String (Temp_File_Name));
end if;
My_Exit_Status := Exit_Status (Spawn (Exec_Path.all, The_Args));
+
+ if not Keep_Temporary_Files then
+ Delete_All_Temp_Files (Project_Tree.Shared);
+ end if;
+
Set_Exit_Status (My_Exit_Status);
end;
end;
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-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- --
("i-java ", F), -- Interfaces.Java
("i-javjni", F), -- Interfaces.Java.JNI
("i-pacdec", F), -- Interfaces.Packed_Decimal
+ ("i-vxinco", F), -- Interfaces.VxWorks.Int_Connection
("i-vxwoio", F), -- Interfaces.VxWorks.IO
("i-vxwork", F), -- Interfaces.VxWorks
-- be connected but disconnection is not possible on VxWorks. Therefore
-- we ensure Notify_Installed is connected at most once.
+ type Interrupt_Connector is access function
+ (Vector : Interrupt_Vector;
+ Handler : Interrupt_Handler;
+ Parameter : System.Address := System.Null_Address) return int;
+ -- Profile must match VxWorks intConnect()
+
+ Interrupt_Connect : Interrupt_Connector :=
+ System.OS_Interface.Interrupt_Connect'Access;
+ pragma Export (C, Interrupt_Connect, "__gnat_user_int_connect");
+ -- Allow user alternatives to the OS implementation of
+ -- System.OS_Interface.Interrupt_Connect. This allows the user to
+ -- associate a handler with an interrupt source when an alternate routine
+ -- is needed to do so. The association is performed in
+ -- Interfaces.VxWorks.Interrupt_Connections. Defaults to the standard OS
+ -- connection routine.
+
-----------------------
-- Local Subprograms --
-----------------------
-- Only install umbrella handler when no Ada handler has already been
-- installed. Note that the interrupt number is passed as a parameter
-- when an interrupt occurs, so the umbrella handler has a different
- -- wrapper generated by intConnect for each interrupt number.
+ -- wrapper generated by the connector routine for each interrupt
+ -- number.
if not Handler_Installed (Interrupt) then
Status :=
- Interrupt_Connect (Vec, Handler, System.Address (Interrupt));
+ Interrupt_Connect.all (Vec, Handler, System.Address (Interrupt));
pragma Assert (Status = 0);
Handler_Installed (Interrupt) := True;
use System.Soft_Links;
function c_malloc (Size : System.CRTL.size_t) return System.Address
- renames System.CRTL.malloc;
+ renames System.CRTL.malloc;
procedure c_free (Ptr : System.Address)
renames System.CRTL.free;
-- unconditionally, and has no restore mechanism, because it is
-- intended as a lowest-level Pure package.
- Save_Max_Line : constant Int := Style_Max_Line_Length;
+ Save_Max_Line : constant Int := Style_Max_Line_Length;
List : Elist_Id;
-- Check for scope mismatch on exit from compilation
pragma Assert (Current_Scope = Standard_Standard
- or else Comp_Unit = Cunit (Main_Unit));
+ or else Comp_Unit = Cunit (Main_Unit));
-- Then pop entry for Standard, and pop implicit types
-------------------------------
procedure Check_Body_Needed_For_SAL (Unit_Name : Entity_Id) is
-
function Entity_Needs_Body (E : Entity_Id) return Boolean;
-- Determine whether use of entity E might require the presence of its
-- body. For a package this requires a recursive traversal of all nested
-- declarations.
- ---------------------------
- -- Entity_Needed_For_SAL --
- ---------------------------
+ -----------------------
+ -- Entity_Needs_Body --
+ -----------------------
function Entity_Needs_Body (E : Entity_Id) return Boolean is
Ent : Entity_Id;
return True;
elsif Ekind_In (E, E_Generic_Function, E_Generic_Procedure) then
- return True;
+
+ -- A generic subprogram always requires the presence of its
+ -- body because an instantiation needs both templates. The only
+ -- exceptions is a generic subprogram renaming. In this case the
+ -- body is needed only when the template is declared outside the
+ -- compilation unit being checked.
+
+ if Present (Renamed_Entity (E)) then
+ return not Within_Scope (E, Unit_Name);
+ else
+ return True;
+ end if;
elsif Ekind (E) = E_Generic_Package
and then
then
Copy_Dimensions (N2, N);
end if;
-
end Set_Global_Type;
------------------
if Is_Global (Entity (Original_Node (N2))) then
N2 := Original_Node (N2);
Set_Associated_Node (N, N2);
- Set_Global_Type (N, N2);
+ Set_Global_Type (N, N2);
-- Renaming is local, and will be resolved in instance
if Is_Global (Entity (Parent (N2))) then
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Parent (N2));
- Set_Global_Type (Parent (N), Parent (N2));
+ Set_Global_Type (Parent (N), Parent (N2));
Save_Entity_Descendants (N);
-- If this is a reference to the current generic entity, replace
if Is_Global (Entity (Name (Parent (N2)))) then
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Name (Parent (N2)));
- Set_Global_Type (Parent (N), Name (Parent (N2)));
+ Set_Global_Type (Parent (N), Name (Parent (N2)));
Save_Entity_Descendants (N);
else
R : Node_Id;
Op_Id : Entity_Id;
T1 : Entity_Id);
- -- For equality and comparison operators, the result is always boolean,
- -- and the legality of the operation is determined from the visibility
- -- of the operand types. If one of the operands has a universal interpre-
- -- tation, the legality check uses some compatible non-universal
- -- interpretation of the other operand. N can be an operator node, or
- -- a function call whose name is an operator designator. Any_Access, which
- -- is the initial type of the literal NULL, is a universal type for the
- -- purpose of this routine.
+ -- For equality and comparison operators, the result is always boolean, and
+ -- the legality of the operation is determined from the visibility of the
+ -- operand types. If one of the operands has a universal interpretation,
+ -- the legality check uses some compatible non-universal interpretation of
+ -- the other operand. N can be an operator node, or a function call whose
+ -- name is an operator designator. Any_Access, which is the initial type of
+ -- the literal NULL, is a universal type for the purpose of this routine.
function Find_Primitive_Operation (N : Node_Id) return Boolean;
- -- Find candidate interpretations for the name Obj.Proc when it appears
- -- in a subprogram renaming declaration.
+ -- Find candidate interpretations for the name Obj.Proc when it appears in
+ -- a subprogram renaming declaration.
procedure Find_Unary_Types
(R : Node_Id;
-- semantics of pragma Component_Alignment.
if Scope_Stack.Last > Scope_Stack.First then
- SST.Component_Alignment_Default := Scope_Stack.Table
- (Scope_Stack.Last - 1).
- Component_Alignment_Default;
+ SST.Component_Alignment_Default :=
+ Scope_Stack.Table
+ (Scope_Stack.Last - 1). Component_Alignment_Default;
-- Otherwise, this is the first scope being pushed on the scope
-- stack. Inherit the component alignment from the configuration
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2015, 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- --
-- Resolve routines also complete the semantic analysis, and call the
-- expander for possible expansion of the completely type resolved node.
- procedure Resolve (N : Node_Id; Typ : Entity_Id);
- procedure Resolve (N : Node_Id; Typ : Entity_Id; Suppress : Check_Id);
- -- Top level type-checking procedure, called in a complete context. The
- -- construct N, which is a subexpression, has already been analyzed, and
- -- is required to be of type Typ given the analysis of the context (which
- -- uses the information gathered on the bottom up phase in Analyze). The
- -- resolve routines do various other processing, e.g. static evaluation.
- -- If a Suppress argument is present, then the resolution is done with the
- -- specified check suppressed (can be All_Checks to suppress all checks).
-
- procedure Resolve (N : Node_Id);
- -- A version of Resolve where the type to be used for resolution is
- -- taken from the Etype (N). This is commonly used in cases where the
- -- context does not add anything and the first pass of analysis found
- -- the correct expected type.
-
- procedure Resolve_Discrete_Subtype_Indication
- (N : Node_Id;
- Typ : Entity_Id);
- -- Resolve subtype indications in choices (case statements and
- -- aggregates) and in index constraints. Note that the resulting Etype
- -- of the subtype indication node is set to the Etype of the contained
- -- range (i.e. an Itype is not constructed for the actual subtype).
-
- procedure Resolve_Entry (Entry_Name : Node_Id);
- -- Find name of entry being called, and resolve prefix of name with its
- -- own type. For now we assume that the prefix cannot be overloaded and
- -- the name of the entry plays no role in the resolution.
+ procedure Ambiguous_Character (C : Node_Id);
+ -- Give list of candidate interpretations when a character literal cannot
+ -- be resolved, for example in a (useless) comparison such as 'A' = 'B'.
+ -- In Ada 95 the literals in question can be of type Character or Wide_
+ -- Character. In Ada 2005 Wide_Wide_Character is also a candidate. The
+ -- node may also be overloaded with user-defined character types.
procedure Analyze_And_Resolve (N : Node_Id);
procedure Analyze_And_Resolve (N : Node_Id; Typ : Entity_Id);
-- is not present, then the Etype of the expression after the Analyze
-- call is used for the Resolve.
- procedure Ambiguous_Character (C : Node_Id);
- -- Give list of candidate interpretations when a character literal cannot
- -- be resolved, for example in a (useless) comparison such as 'A' = 'B'.
- -- In Ada 95 the literals in question can be of type Character or Wide_
- -- Character. In Ada 2005 Wide_Wide_Character is also a candidate. The
- -- node may also be overloaded with user-defined character types.
-
procedure Check_Parameterless_Call (N : Node_Id);
- -- Several forms of names can denote calls to entities without para-
- -- meters. The context determines whether the name denotes the entity
- -- or a call to it. When it is a call, the node must be rebuilt
- -- accordingly and reanalyzed to obtain possible interpretations.
+ -- Several forms of names can denote calls to entities without parameters.
+ -- The context determines whether the name denotes the entity or a call to
+ -- it. When it is a call, the node must be rebuilt accordingly and
+ -- reanalyzed to obtain possible interpretations.
--
-- The name may be that of an overloadable construct, or it can be an
-- explicit dereference of a prefix that denotes an access to subprogram.
-- In that case, we want to convert the name into a call only if the
- -- context requires the return type of the subprogram. Finally, a
+ -- context requires the return type of the subprogram. Finally, a
-- parameterless protected subprogram appears as a selected component.
--
-- The parameter T is the Typ for the corresponding resolve call.
procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id);
- -- Performs a pre-analysis of expression node N. During pre-analysis,
- -- N is analyzed and then resolved against type T, but no expansion
- -- is carried out for N or its children. For more info on pre-analysis
- -- read the spec of Sem.
+ -- Performs a pre-analysis of expression node N. During pre-analysis, N is
+ -- analyzed and then resolved against type T, but no expansion is carried
+ -- out for N or its children. For more info on pre-analysis read the spec
+ -- of Sem.
procedure Preanalyze_And_Resolve (N : Node_Id);
-- Same, but use type of node because context does not impose a single type
+ procedure Resolve (N : Node_Id; Typ : Entity_Id);
+ procedure Resolve (N : Node_Id; Typ : Entity_Id; Suppress : Check_Id);
+ -- Top-level type-checking procedure, called in a complete context. The
+ -- construct N, which is a subexpression, has already been analyzed, and
+ -- is required to be of type Typ given the analysis of the context (which
+ -- uses the information gathered on the bottom-up phase in Analyze). The
+ -- resolve routines do various other processing, e.g. static evaluation.
+ -- If a Suppress argument is present, then the resolution is done with the
+ -- specified check suppressed (can be All_Checks to suppress all checks).
+
+ procedure Resolve (N : Node_Id);
+ -- A version of Resolve where the type to be used for resolution is taken
+ -- from the Etype (N). This is commonly used in cases where the context
+ -- does not add anything and the first pass of analysis found the correct
+ -- expected type.
+
+ procedure Resolve_Discrete_Subtype_Indication
+ (N : Node_Id;
+ Typ : Entity_Id);
+ -- Resolve subtype indications in choices (case statements and aggregates)
+ -- and in index constraints. Note that the resulting Etype of the subtype_
+ -- indication node is set to the Etype of the contained range (i.e. an
+ -- Itype is not constructed for the actual subtype).
+
+ procedure Resolve_Entry (Entry_Name : Node_Id);
+ -- Find name of entry being called, and resolve prefix of name with its
+ -- own type. For now we assume that the prefix cannot be overloaded and
+ -- the name of the entry plays no role in the resolution.
+
function Valid_Conversion
(N : Node_Id;
Target : Entity_Id;
private
procedure Resolve_Implicit_Type (N : Node_Id) renames Resolve;
pragma Inline (Resolve_Implicit_Type);
- -- We use this renaming to make the application of Inline very explicit
- -- to this version, since other versions of Resolve are not inlined.
+ -- We use this renaming to make the application of Inline very explicit to
+ -- this version, since other versions of Resolve are not inlined.
end Sem_Res;
-- Acts_As_Spec (Flag4-Sem)
-- Bad_Is_Detected (Flag15) used only by parser
-- Do_Storage_Check (Flag17-Sem)
+ -- Has_Relative_Deadline_Pragma (Flag9-Sem)
-- Is_Entry_Barrier_Function (Flag8-Sem)
-- Is_Protected_Subprogram_Body (Flag7-Sem)
-- Is_Task_Body_Procedure (Flag1-Sem)
-- Is_Task_Master (Flag5-Sem)
- -- Was_Originally_Stub (Flag13-Sem)
- -- Has_Relative_Deadline_Pragma (Flag9-Sem)
-- Was_Expression_Function (Flag18-Sem)
+ -- Was_Originally_Stub (Flag13-Sem)
-------------------------
-- Expression Function --