+2011-08-05 Arnaud Charlet <charlet@adacore.com>
+
+ * make.adb (Linking_Phase): No longer need to set source search path
+ before calling gnatlink in CodePeer mode.
+ * gnatlink.adb (Gnatlink): No longer pass -gnat83/95/05/12 switch to
+ gcc in CodePeer mode, since the binder generated file no longer has a
+ 'with Main'.
+ * switch.ads, switch.adb (Is_Language_Switch): Removed.
+ * switch-c.adb: Update comment.
+
+2011-08-05 Thomas Quinot <quinot@adacore.com>
+
+ * exp_strm.adb, bindgen.adb, s-ficobl.ads: Minor reformatting.
+
+2011-08-05 Nicolas Roche <roche@adacore.com>
+
+ * gnat_ugn.texi: Fix minor syntax error issue.
+
+2011-08-05 Vincent Celier <celier@adacore.com>
+
+ * gnatcmd.adb (Get_Closure): Do not crash when it is not possible to
+ delete or close the file when the call to gnatmake returns a non
+ successful return code.
+
+2011-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Type_Conversion): When expanding a predicate
+ check, indicate that the copy of the original node does not come from
+ source, to prevent an infinite recursion of the expansion.
+
+2011-08-05 Johannes Kanig <kanig@adacore.com>
+
+ * debug.adb: document switch -gnatd.G for gnat2why, which deactivates
+ VC generation for subprogram bodies.
+
+2011-08-05 Yannick Moy <moy@adacore.com>
+
+ * einfo.ads: Typo.
+ * sem_ch3.adb (Signed_Integer_Type_Declaration): in ALFA mode, define
+ the base type with the smallest allowed base type.
+
+2011-08-05 Sergey Rybin <rybin@adacore.com>
+
+ * tree_gen.adb, tree_in.adb, aspects.adb: Fix tree read-write for
+ aspects.
+
+2011-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.ads: minor comment updates.
+
+2011-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Analyze_Formal_Package_Declaration): in an
+ instantiation and a formal package the compiler generates a package
+ renaming declaration so that the generic name within the declaration
+ is interpreted as a renaming of the instance. At the end of a formal
+ package declaration, this renaming must become invisible.
+
2011-08-05 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Is_Init_Call): Reimplemented to avoid character
package body Aspects is
+ procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id);
+ -- Same as Set_Aspect_Specifications, but does not contain the assertion
+ -- that checks that N does not already have aspect specifications. This
+ -- subprogram is supposed to be used as a part of Tree_Read. When reading
+ -- the tree we first read nodes with their basic properties (as
+ -- Atree.Tree_Read), this includes reading the Has_Aspects flag for each
+ -- node, then we reed all the list tables and only after that we call
+ -- Tree_Read for Aspects. That is, when reading the tree, the list of
+ -- aspects is attached to the node that already has Has_Aspects flag set
+ -- ON
+
------------------------------------------
-- Hash Table for Aspect Specifications --
------------------------------------------
Aspect_Specifications_Hash_Table.Set (N, L);
end Set_Aspect_Specifications;
+ ----------------------------------------
+ -- Set_Aspect_Specifications_No_Check --
+ ----------------------------------------
+
+ procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id) is
+ begin
+ pragma Assert (Permits_Aspect_Specifications (N));
+ pragma Assert (L /= No_List);
+
+ Set_Has_Aspects (N);
+ Set_Parent (L, N);
+ Aspect_Specifications_Hash_Table.Set (N, L);
+ end Set_Aspect_Specifications_No_Check;
+
---------------
-- Tree_Read --
---------------
Tree_Read_Int (Int (Node));
Tree_Read_Int (Int (List));
exit when List = No_List;
- Set_Aspect_Specifications (Node, List);
+ Set_Aspect_Specifications_No_Check (Node, List);
end loop;
end Tree_Read;
WBI ("");
-- For CodePeer, declare a wrapper for the user-defined main program
+
if CodePeer_Mode then
Gen_CodePeer_Wrapper;
end if;
-- d.D
-- d.E
-- d.F ALFA mode
- -- d.G
+ -- d.G Precondition only mode for gnat2why
-- d.H
-- d.I SCIL generation mode
-- d.J Disable parallel SCIL generation mode
-- as well as additional cross reference information in ALI files to
-- compute effects of subprograms.
+ -- d.G Precondition only mode for gnat2why. In this mode, gnat2why will
+ -- only generate Why code that checks for the well-guardedness of
+ -- preconditions.
+
-- d.I Generate SCIL mode. Generate intermediate code for the sake of
-- of static analysis tools, and ensure additional tree consistency
-- between different compilations of specs.
-- The Ada 95 RM contains some rather peculiar (to us!) rules on the value
-- of type'Size (see RM 13.3(55)). We have found that attempting to use
-- these RM Size values generally, and in particular for determining the
--- default size of objects, creates chaos, and major incompatibilies in
+-- default size of objects, creates chaos, and major incompatibilities in
-- existing code.
-- We proceed as follows, for discrete and fixed-point subtypes, we have
and then Target_Type /= Operand_Type
and then Comes_From_Source (N)
then
- Insert_Action (N,
- Make_Predicate_Check (Target_Type, Duplicate_Subexpr (N)));
+ declare
+ New_Expr : constant Node_Id := Duplicate_Subexpr (N);
+
+ begin
+ -- Avoid infinite recursion on the subsequent expansion of
+ -- of the copy of the original type conversion.
+
+ Set_Comes_From_Source (New_Expr, False);
+ Insert_Action (N, Make_Predicate_Check (Target_Type, New_Expr));
+ end;
end if;
end Expand_N_Type_Conversion;
Selector_Name => Make_Identifier (Loc, Name_V));
-- Generate Reads for the discriminants of the type. The discriminants
- -- need to be read before the rest of the components, so that
- -- variants are initialized correctly. The discriminants must be read
- -- into temporary variables so an incomplete Read (interrupted by an
- -- exception, for example) does not alter the passed object.
+ -- need to be read before the rest of the components, so that variants
+ -- are initialized correctly. The discriminants must be read into temp
+ -- variables so an incomplete Read (interrupted by an exception, for
+ -- example) does not alter the passed object.
while Present (Disc) loop
Tmp_For_Disc := Make_Defining_Identifier (Loc,
Append_To (Stms,
Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Etype (Disc), Loc),
+ Prefix => New_Occurrence_Of (Etype (Disc), Loc),
Attribute_Name => Name_Read,
- Expressions => New_List (
+ Expressions => New_List (
Make_Identifier (Loc, Name_S),
New_Occurrence_Of (Tmp_For_Disc, Loc))));
Left_Opnd => New_Occurrence_Of (Tmp_For_Disc, Loc),
Right_Opnd =>
Make_Selected_Component (Loc,
- Prefix => New_Copy_Tree (Out_Formal),
+ Prefix => New_Copy_Tree (Out_Formal),
Selector_Name => New_Occurrence_Of (Disc, Loc))),
Reason => CE_Discriminant_Check_Failed));
Next_Discriminant (Disc);
end loop;
- -- Generate reads for the components of the record (including
- -- those that depend on discriminants).
+ -- Generate reads for the components of the record (including those
+ -- that depend on discriminants).
Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read);
Constrained_Stms := Statements (Handled_Statement_Sequence (Decl));
Append_To (Stms,
Make_Block_Statement (Loc,
- Declarations => Dcls,
+ Declarations => Dcls,
Handled_Statement_Sequence => Parent (Constrained_Stms)));
Append_To (Constrained_Stms,
Make_Implicit_If_Statement (Pnam,
Condition =>
Make_Attribute_Reference (Loc,
- Prefix => New_Copy_Tree (Out_Formal),
+ Prefix => New_Copy_Tree (Out_Formal),
Attribute_Name => Name_Constrained),
Then_Statements => Discriminant_Checks));
sense;
@item
-emph{unit coupling} - for all the program units making up a program;
+@emph{unit coupling} - for all the program units making up a program;
@item
-emph{control coupling} - this metric counts dependencies between a unit and
+@emph{control coupling} - this metric counts dependencies between a unit and
only those units that define subprograms;
@end itemize
if Return_Code /= 0 then
Get_Line (File, Line, Last);
- if not Keep_Temporary_Files then
- Delete (File);
- else
- Close (File);
- end if;
+ begin
+ if not Keep_Temporary_Files then
+ Delete (File);
+ else
+ Close (File);
+ end if;
+
+ exception
+ -- Don't crash if it is not possible to delete or close the file
+ when others =>
+ null;
+ end;
Put_Line (Standard_Error, Line (1 .. Last));
Put_Line
-- is to be dealt with specially because it needs to be passed
-- if the binder-generated file is in Ada and may also be used
-- to drive the linker.
- -- Also in CodePeer mode, we need to pass the -gnat05 or
- -- -gnat12 switches to be able to compile the binder file.
declare
Arg : String_Ptr renames Args.Table (Index);
begin
- if not Is_Front_End_Switch (Arg.all)
- or else (Opt.CodePeer_Mode
- and then Is_Language_Switch (Arg.all))
- then
+ if not Is_Front_End_Switch (Arg.all) then
Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table
(Binder_Options_From_ALI.Last) := String_Access (Arg);
end if;
end if;
- -- Put the object directories in ADA_OBJECTS_PATH. Same treatment for
- -- source directories in ADA_INCLUDE_PATH if in CodePeer mode.
+ -- Put the object directories in ADA_OBJECTS_PATH.
Prj.Env.Set_Ada_Paths
(Main_Project,
Project_Tree,
Including_Libraries => False,
- Include_Path => CodePeer_Mode);
+ Include_Path => False);
-- Check for attributes Linker'Linker_Options in projects other than
-- the main project
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
-- Indicates sharing status of file, see description of type above
Access_Method : Character;
- -- Set to 'Q', 'S', 'T, 'D' for Sequential_IO, Stream_IO, Text_IO
+ -- Set to 'Q', 'S', 'T, 'D' for Sequential_IO, Stream_IO, Text_IO,
-- Direct_IO file (used to validate file sharing request).
Next : AFCB_Ptr;
Renaming : Node_Id;
Parent_Instance : Entity_Id;
Renaming_In_Par : Entity_Id;
- No_Associations : Boolean := False;
+ Associations : Boolean := True;
function Build_Local_Package return Node_Id;
-- The formal package is rewritten so that its parameters are replaced
or else No (Generic_Associations (N))
or else Nkind (First (Generic_Associations (N))) = N_Others_Choice
then
- No_Associations := True;
+ Associations := False;
end if;
-- If there are no generic associations, the generic parameters appear
-- The formals for which associations are provided are not visible
-- outside of the formal package. The others are still declared by a
-- formal parameter declaration.
+ -- If there are no associations, the only local entity to hide is the
+ -- generated package renaming itself.
- if not No_Associations then
- declare
- E : Entity_Id;
+ declare
+ E : Entity_Id;
- begin
- E := First_Entity (Formal);
- while Present (E) loop
- exit when Ekind (E) = E_Package
- and then Renamed_Entity (E) = Formal;
+ begin
+ E := First_Entity (Formal);
+ while Present (E) loop
- if not Is_Generic_Formal (E) then
- Set_Is_Hidden (E);
- end if;
+ if Associations
+ and then not Is_Generic_Formal (E)
+ then
+ Set_Is_Hidden (E);
+ end if;
- Next_Entity (E);
- end loop;
- end;
- end if;
+ if Ekind (E) = E_Package
+ and then Renamed_Entity (E) = Formal
+ then
+ Set_Is_Hidden (E);
+ exit;
+ end if;
+
+ Next_Entity (E);
+ end loop;
+ end;
End_Package_Scope (Formal);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
procedure Save_Env
(Gen_Unit : Entity_Id;
Act_Unit : Entity_Id);
- -- ??? comment needed
+ -- Because instantiations can be nested, the compiler maintains a stack
+ -- of environments that holds variables relevant to the current instance:
+ -- most importanty Instantiated_Parent, Exchanged_Views, Hidden_Entities,
+ -- and others (see full list in Instance_Env).
procedure Restore_Env;
- -- ??? comment needed
+ -- After processing an instantiation, or aborting one because of semantic
+ -- errors, remove the current Instantiation_Env from Instantation_Envs.
procedure Initialize;
-- Initializes internal data structures
Set_Ekind (T, E_Signed_Integer_Subtype);
Set_Etype (T, Implicit_Base);
+ -- In formal verification mode, override partially the decisions above
+ -- to restrict base type's range to the minimum allowed by RM 3.5.4,
+ -- namely the smallest symmetric range around zero with a possible extra
+ -- negative value that contains the subtype range. Keep Size, RM_Size
+ -- and First_Rep_Item info, which should not be relied upon in formal
+ -- verification.
+
+ if ALFA_Mode then
+
+ -- If the range of the type is already symmetric with a possible
+ -- extra negative value, just make the type its own base type.
+
+ if UI_Le (Lo_Val, Hi_Val)
+ and then (UI_Eq (Lo_Val, UI_Negate (Hi_Val))
+ or else
+ UI_Eq (Lo_Val, UI_Sub (UI_Negate (Hi_Val), Uint_1)))
+ then
+ Set_Etype (T, T);
+
+ else
+ declare
+ Sym_Hi_Val : Uint;
+ Sym_Lo_Val : Uint;
+ Decl : Node_Id;
+ Dloc : constant Source_Ptr := Sloc (Def);
+ Lbound : Node_Id;
+ Ubound : Node_Id;
+
+ begin
+ -- If the subtype range is empty, the smallest base type range
+ -- is the symmetric range around zero containing Lo_Val and
+ -- Hi_Val.
+
+ if UI_Gt (Lo_Val, Hi_Val) then
+ Sym_Hi_Val := UI_Max (UI_Abs (Lo_Val), UI_Abs (Hi_Val));
+ Sym_Lo_Val := UI_Negate (Sym_Hi_Val);
+
+ -- Otherwise, if the subtype range is not empty and Hi_Val has
+ -- the largest absolute value, Hi_Val is non negative and the
+ -- smallest base type range is the symmetric range around zero
+ -- containing Hi_Val.
+
+ elsif UI_Le (UI_Abs (Lo_Val), UI_Abs (Hi_Val)) then
+ Sym_Hi_Val := Hi_Val;
+ Sym_Lo_Val := UI_Negate (Hi_Val);
+
+ -- Otherwise, the subtype range is not empty, Lo_Val has the
+ -- strictly largest absolute value, Lo_Val is negative and the
+ -- smallest base type range is the symmetric range around zero
+ -- with an extra negative value Lo_Val.
+
+ else
+ Sym_Lo_Val := Lo_Val;
+ Sym_Hi_Val := UI_Sub (UI_Negate (Lo_Val), Uint_1);
+ end if;
+
+ Lbound := Make_Integer_Literal (Dloc, Sym_Lo_Val);
+ Ubound := Make_Integer_Literal (Dloc, Sym_Hi_Val);
+ Set_Is_Static_Expression (Lbound);
+ Set_Is_Static_Expression (Ubound);
+
+ Decl := Make_Full_Type_Declaration (Dloc,
+ Defining_Identifier => Implicit_Base,
+ Type_Definition =>
+ Make_Signed_Integer_Type_Definition (Dloc,
+ Low_Bound => Lbound,
+ High_Bound => Ubound));
+
+ Analyze (Decl);
+ Set_Etype (Implicit_Base, Implicit_Base);
+ Insert_Before (Parent (Def), Decl);
+ end;
+ end if;
+ end if;
+
Set_Size_Info (T, (Implicit_Base));
Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base));
Set_Scalar_Range (T, Def);
("-gnatZ is no longer supported: consider using --RTS=zcx");
-- Note on language version switches: whenever a new language
- -- version switch is added, function Switch.Is_Language_Switch and
- -- procedure Switch.M.Normalize_Compiler_Switches must be updated.
+ -- version switch is added, procedure
+ -- Switch.M.Normalize_Compiler_Switches must be updated.
-- Processing for 83 switch
and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS"));
end Is_Front_End_Switch;
- -------------------------
- -- Is_Language_Switch --
- -------------------------
-
- function Is_Language_Switch (Switch_Chars : String) return Boolean is
- Ptr : constant Positive := Switch_Chars'First;
- begin
- return Is_Switch (Switch_Chars)
- and then
- (Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat83"
- or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat95"
- or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat05"
- or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat2005"
- or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat12"
- or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat2012");
- end Is_Language_Switch;
-
----------------------------
-- Is_Internal_GCC_Switch --
----------------------------
-- Returns True iff Switch_Chars represents a front-end switch, i.e. it
-- starts with -I, -gnat or -?RTS.
- function Is_Language_Switch (Switch_Chars : String) return Boolean;
- -- Returns True iff Switch_Chars represents a language switch, i.e. it
- -- specifies -gnat83/95/2005/2012.
-
function Is_Internal_GCC_Switch (Switch_Chars : String) return Boolean;
-- Returns True iff Switch_Chars represents an internal GCC switch to be
-- followed by a single argument, such as -dumpbase, --param or -auxbase.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
with Aspects;
with Atree;
-with Debug;
with Elists;
with Fname;
with Lib;
begin
if Opt.Tree_Output then
Osint.C.Tree_Create;
- Opt.Tree_Write;
-
- -- For now, only write aspect specifications hash table if -gnatd.A set
-
- if Debug.Debug_Flag_Dot_AA then
- Aspects.Tree_Write;
- end if;
+ Opt.Tree_Write;
Atree.Tree_Write;
Elists.Tree_Write;
Fname.Tree_Write;
Uintp.Tree_Write;
Urealp.Tree_Write;
Repinfo.Tree_Write;
+ Aspects.Tree_Write;
+
Osint.C.Tree_Close;
end if;
end Tree_Gen;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
with Aspects;
with Atree;
with Csets;
-with Debug;
with Elists;
with Fname;
with Lib;
procedure Tree_In (Desc : File_Descriptor) is
begin
Tree_IO.Tree_Read_Initialize (Desc);
- Opt.Tree_Read;
-
- -- For now, only read aspect specifications hash table if -gnatd.A is set
-
- if Debug.Debug_Flag_Dot_AA then
- Aspects.Tree_Read;
- end if;
+ Opt.Tree_Read;
Atree.Tree_Read;
Elists.Tree_Read;
Fname.Tree_Read;
Uintp.Tree_Read;
Urealp.Tree_Read;
Repinfo.Tree_Read;
+ Aspects.Tree_Read;
+
Csets.Initialize;
end Tree_In;
projects / gcc.git / commitdiff