+2009-07-20 Vadim Godunko <godunko@adacore.com>
+
+ * a-coorma.adb: Minor reformatting.
+
+2009-07-20 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3 (Build_Itype_Reference): Make public, for use on non-null
+ access return types.
+ * sem_ch6.adb (Analyze_Return_Type): If return is a not null subtype,
+ provide an itype reference to gigi to force elaboration of the subtype
+ at the proper point.
+
+2009-07-20 Tristan Gingold <gingold@adacore.com>
+
+ * g-expect.adb: Avoid closeing already closed handle.
+
+2009-07-20 Robert Dewar <dewar@adacore.com>
+
+ * sprint.adb (Write_Subprogram_Name): New procedure to output
+ subprogram name with possible preceding $ (replaces
+ Note_Implicit_Run_Time_Call).
+
2009-07-20 Robert Dewar <dewar@adacore.com>
* vms_data.ads: Minor reformatting
end if;
end Include;
+ ------------
+ -- Insert --
+ ------------
+
procedure Insert
(Container : in out Map;
Key : Key_Type;
end if;
end Insert;
- ------------
- -- Insert --
- ------------
-
procedure Insert
(Container : in out Map;
Key : Key_Type;
Send (Process, Input);
end if;
- GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+ Close (Process.Input_Fd);
+ Process.Input_Fd := Invalid_FD;
declare
Result : Expect_Match;
pragma Warnings (Off, Pipe1);
pragma Warnings (Off, Pipe2);
pragma Warnings (Off, Pipe3);
+
begin
Close (Pipe1.Input);
Close (Pipe2.Output);
- Close (Pipe3.Output);
+
+ if Pipe3.Output /= Pipe2.Output then
+ Close (Pipe3.Output);
+ end if;
end Set_Up_Parent_Communications;
------------------
-- Needs a more complete spec--what are the parameters exactly, and what
-- exactly is the returned value, and how is Bound affected???
- procedure Build_Itype_Reference
- (Ityp : Entity_Id;
- Nod : Node_Id);
- -- Create a reference to an internal type, for use by Gigi. The back-end
- -- elaborates itypes on demand, i.e. when their first use is seen. This
- -- can lead to scope anomalies if the first use is within a scope that is
- -- nested within the scope that contains the point of definition of the
- -- itype. The Itype_Reference node forces the elaboration of the itype
- -- in the proper scope. The node is inserted after Nod, which is the
- -- enclosing declaration that generated Ityp.
- --
- -- A related mechanism is used during expansion, for itypes created in
- -- branches of conditionals. See Ensure_Defined in exp_util.
- -- Could both mechanisms be merged ???
-
procedure Build_Underlying_Full_View
(N : Node_Id;
Typ : Entity_Id;
Set_Convention (T1, Convention (T2));
Set_Is_Limited_Composite (T1, Is_Limited_Composite (T2));
Set_Is_Private_Composite (T1, Is_Private_Composite (T2));
+ Set_Packed_Array_Type (T1, Packed_Array_Type (T2));
end Copy_Array_Subtype_Attributes;
-----------------------------------
procedure Access_Type_Declaration (T : Entity_Id; Def : Node_Id);
-- Process an access type declaration
+ procedure Build_Itype_Reference
+ (Ityp : Entity_Id;
+ Nod : Node_Id);
+ -- Create a reference to an internal type, for use by Gigi. The back-end
+ -- elaborates itypes on demand, i.e. when their first use is seen. This
+ -- can lead to scope anomalies if the first use is within a scope that is
+ -- nested within the scope that contains the point of definition of the
+ -- itype. The Itype_Reference node forces the elaboration of the itype
+ -- in the proper scope. The node is inserted after Nod, which is the
+ -- enclosing declaration that generated Ityp.
+ --
+ -- A related mechanism is used during expansion, for itypes created in
+ -- branches of conditionals. See Ensure_Defined in exp_util.
+ -- Could both mechanisms be merged ???
+
procedure Check_Abstract_Overriding (T : Entity_Id);
-- Check that all abstract subprograms inherited from T's parent type
-- have been overridden as required, and that nonabstract subprograms
then
null;
+ elsif Etype (Base_Type (R_Type)) = R_Stm_Type
+ and then Is_Null_Extension (Base_Type (R_Type))
+ then
+ null;
+
else
Error_Msg_N
("wrong type for return_subtype_indication", Subtype_Ind);
then
Set_Etype (Designator,
Create_Null_Excluding_Itype
- (T => Typ,
- Related_Nod => N,
- Scope_Id => Scope (Current_Scope)));
+ (T => Typ,
+ Related_Nod => N,
+ Scope_Id => Scope (Current_Scope)));
+
+ -- The new subtype must be elaborated before use because
+ -- it is visible outside of the function. However its base
+ -- type may not be frozen yet, so the reference that will
+ -- force elaboration must be attached to the freezing of
+ -- the base type.
+
+ if Is_Frozen (Typ) then
+ Build_Itype_Reference
+ (Etype (Designator), Parent (N));
+ else
+ Ensure_Freeze_Node (Typ);
+
+ declare
+ IR : constant Node_Id :=
+ Make_Itype_Reference (Sloc (N));
+
+ begin
+ Set_Itype (IR, Etype (Designator));
+ Append_Freeze_Actions (Typ, New_List (IR));
+ end;
+ end if;
+
else
Set_Etype (Designator, Typ);
end if;
procedure Indent_End;
-- Decrease indentation level
- procedure Note_Implicit_Run_Time_Call (N : Node_Id);
- -- N is the Name field of a function call or procedure statement call.
- -- The effect of the call is to output a $ if the call is identified as
- -- an implicit call to a run time routine.
-
procedure Print_Debug_Line (S : String);
-- Used to print output lines in Debug_Generated_Code mode (this is used
-- as the argument for a call to Set_Special_Output in package Output).
-- Like Write_Str_With_Col_Check, but sets debug Sloc of current debug
-- node to first non-blank character if a current debug node is active.
+ procedure Write_Subprogram_Name (N : Node_Id);
+ -- N is the Name field of a function call or procedure statement call.
+ -- The effect of the call is to output the name, preceded by a $ if the
+ -- call is identified as an implicit call to a run time routine.
+
procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format);
-- Write Uint (using UI_Write) with initial column check, and possible
-- initial Write_Indent (to get new line) if current line is too full.
Indent := Indent - 3;
end Indent_End;
- ---------------------------------
- -- Note_Implicit_Run_Time_Call --
- ---------------------------------
-
- procedure Note_Implicit_Run_Time_Call (N : Node_Id) is
- begin
- if not Comes_From_Source (N)
- and then Is_Entity_Name (N)
- then
- declare
- Ent : constant Entity_Id := Entity (N);
- begin
- if not In_Extended_Main_Source_Unit (Ent)
- and then
- Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Ent)))
- then
- Col_Check (Length_Of_Name (Chars (Ent)));
- Write_Char ('$');
- end if;
- end;
- end if;
- end Note_Implicit_Run_Time_Call;
-
--------
-- pg --
--------
when N_Function_Call =>
Set_Debug_Sloc;
- Note_Implicit_Run_Time_Call (Name (Node));
- Sprint_Node (Name (Node));
+ Write_Subprogram_Name (Name (Node));
Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
when N_Function_Instantiation =>
when N_Procedure_Call_Statement =>
Write_Indent;
Set_Debug_Sloc;
- Note_Implicit_Run_Time_Call (Name (Node));
- Sprint_Node (Name (Node));
+ Write_Subprogram_Name (Name (Node));
Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
Write_Char (';');
end if;
end Write_Str_With_Col_Check_Sloc;
+ ---------------------------
+ -- Write_Subprogram_Name --
+ ---------------------------
+
+ procedure Write_Subprogram_Name (N : Node_Id) is
+ begin
+ if not Comes_From_Source (N)
+ and then Is_Entity_Name (N)
+ then
+ declare
+ Ent : constant Entity_Id := Entity (N);
+ begin
+ if not In_Extended_Main_Source_Unit (Ent)
+ and then
+ Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Ent)))
+ then
+ -- Run-time routine name, output name with a preceding dollar
+ -- making sure that we do not get a line split between them.
+
+ Col_Check (Length_Of_Name (Chars (Ent)) + 1);
+ Write_Char ('$');
+ Write_Name (Chars (Ent));
+ return;
+ end if;
+ end;
+ end if;
+
+ -- Normal case, not a run-time routine name
+
+ Sprint_Node (N);
+ end Write_Subprogram_Name;
+
-------------------------------
-- Write_Uint_With_Col_Check --
-------------------------------
OSDN Git Service
