+2013-02-06 Robert Dewar <dewar@adacore.com>
+
+ * osint.ads: Minor fix of typo.
+
+2013-02-06 Sergey Rybin <rybin@adacore.com frybin>
+
+ * gnat_ugn.texi: gnatmetric: update the documentation of
+ complexity metrics for Ada 2012.
+
+2013-02-06 Javier Miranda <miranda@adacore.com>
+
+ * exp_disp.adb (Make_Secondary_DT): Code cleanup:
+ remove useless initialization.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Build_Discriminant_Constraints): Do not
+ generate overflow checks on a discriminant expression if the
+ discriminant constraint is applied to a private type that has
+ a full view, because the check will be applied when the full
+ view is elaborated. Removing the redundant check is not just
+ an optimization, but it prevents spurious assembler errors,
+ because of the way the backend generates names for expressions
+ that require overflow checking.
+
+2013-02-06 Pascal Obry <obry@adacore.com>
+
+ * s-osprim-mingw.adb: Removes workaround for an old GNU/Linker
+ limitation on Windows.
+ (DA): Removed.
+ (LIA): Removed.
+ (LLIA): Removed.
+ (TFA): Removed.
+ (BTA): Removed.
+ (BMTA): Removed.
+ (BCA): Removed.
+ (BMCA): Removed.
+ (BTiA): Removed.
+ (Clock): Use variable corresponding to access.
+ (Get_Base_Time): Likewise.
+ (Monotonic_Clock): Likewise.
+
+2013-02-06 Vincent Celier <celier@adacore.com>
+
+ * make.adb (Gnatmake): When gnatmake is called with a project
+ file, do not invoke gnatbind with -I-.
+ * makeutl.adb (Create_Binder_Mapping_File): Rewrite function. Get
+ the infos from all the sources.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * snames.ads-tmpl: Add Name_Overriding_Renamings and pragma
+ Overriding_Renamings.
+ * par-prag.adb: Recognize pragma Overriding_Renamings.
+ * opt.ads (Overriding_Renamings): flag to control compatibility
+ mode with Rational compiler, replaces Rational_Profile flag.
+ * sem_ch8.adb (Analyze_Subprogram_Renaming): When
+ Overriding_Renamings is enabled, accept renaming declarations
+ where the new subprogram renames and overrides a locally inherited
+ operation. Improve error message for some illegal renamings.
+ * sem_prag.adb (Analyze_Pragma): Add case for Overriding_Renamings.
+ (Set_Rational_Profile): The Rational_Profile enables
+ Overriding_Renamings, Implicit_Packing, and Use_Vads_Size.
+
+2013-02-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.adb: Set parent of copied aggregate component, to
+ prevent infinite loop.
+
2013-02-06 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch10.adb: Minor reformatting.
DT_Constr_List := New_List;
DT_Aggr_List := New_List;
- -- Nb_Prim. If the tagged type has no primitives we add a dummy
- -- slot whose address will be the tag of this type.
-
- -- ???codepeer???
- -- Nb_Prim cannot be zero here, so this test is wrong
+ -- Nb_Prim
- if Nb_Prim = 0 then
- New_Node := Make_Integer_Literal (Loc, 1);
- else
- New_Node := Make_Integer_Literal (Loc, Nb_Prim);
- end if;
-
- Append_To (DT_Constr_List, New_Node);
- Append_To (DT_Aggr_List, New_Copy (New_Node));
+ Append_To (DT_Constr_List, Make_Integer_Literal (Loc, Nb_Prim));
+ Append_To (DT_Aggr_List, Make_Integer_Literal (Loc, Nb_Prim));
-- Signature
@c o
@c G N A T _ U G N o
@c o
-@c Copyright (C) 1992-2012, Free Software Foundation, Inc. o
+@c Copyright (C) 1992-2013, Free Software Foundation, Inc. o
@c o
@c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
in @url{http://www.mccabe.com/pdf/mccabe-nist235r.pdf}
According to McCabe, both control statements and short-circuit control forms
-should be taken into account when computing cyclomatic complexity. For each
-body, we compute three metric values:
+should be taken into account when computing cyclomatic complexity.
+For Ada 2012 we have also take into account conditional expressions
+and quantified expressions. For each body, we compute three metric values:
@itemize @bullet
@item
@noindent
+The cyclomatic complexity is also computed for Ada 2012 expression functions.
+An expression function cannot have statements as its components, so only one
+metric value is computed as a cyclomatic complexity of an expression function.
+
The origin of cyclomatic complexity metric is the need to estimate the number
of independent paths in the control flow graph that in turn gives the number
of tests needed to satisfy paths coverage testing completeness criterion.
are not penalized as unstructured in the Ada essential complexity metric.
When computing cyclomatic and essential complexity, @command{gnatmetric} skips
-the code in the exception handlers and in all the nested program units.
+the code in the exception handlers and in all the nested program units. The
+code of assertions and predicates (that is, subprogram preconditions and
+postconditions, subtype predicates and type invariants) is also skipped.
By default, all the complexity metrics are computed and reported.
For more fine-grained control you can use
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, 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- --
-- projects.
Look_In_Primary_Dir := False;
- Add_Switch ("-I-", Binder, And_Save => True);
end if;
-- If the user wants a program without a main subprogram, add the
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2013, 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- --
Status : Boolean;
-- For call to Close
+ Iter : Source_Iterator :=
+ For_Each_Source
+ (In_Tree => Project_Tree,
+ Language => Name_Ada,
+ Encapsulated_Libs => False,
+ Locally_Removed => False);
+ Source : Prj.Source_Id;
+
begin
Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path);
Record_Temp_File (Project_Tree.Shared, Mapping_Path);
if Mapping_FD /= Invalid_FD then
OK := True;
- -- Traverse all units
+ loop
+ Source := Element (Iter);
+ exit when Source = No_Source;
- Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
- while Unit /= No_Unit_Index loop
- if Unit.Name /= No_Name then
+ Unit := Source.Unit;
- -- If there is a body, put it in the mapping
+ if Unit = No_Unit_Index or else Unit.Name = No_Name then
+ ALI_Name := No_File;
- if Unit.File_Names (Impl) /= No_Source
- and then Unit.File_Names (Impl).Project /= No_Project
- then
- Get_Name_String (Unit.Name);
- Add_Str_To_Name_Buffer ("%b");
- ALI_Unit := Name_Find;
- ALI_Name :=
- Lib_File_Name (Unit.File_Names (Impl).Display_File);
- ALI_Project := Unit.File_Names (Impl).Project;
+ -- If this is a body, put it in the mapping
- -- Otherwise, if there is a spec, put it in the mapping
-
- elsif Unit.File_Names (Spec) /= No_Source
- and then Unit.File_Names (Spec).Project /= No_Project
- then
- Get_Name_String (Unit.Name);
- Add_Str_To_Name_Buffer ("%s");
- ALI_Unit := Name_Find;
- ALI_Name :=
- Lib_File_Name (Unit.File_Names (Spec).Display_File);
- ALI_Project := Unit.File_Names (Spec).Project;
+ elsif Source.Kind = Impl
+ and then Unit.File_Names (Impl) /= No_Source
+ and then Unit.File_Names (Impl).Project /= No_Project
+ then
+ Get_Name_String (Unit.Name);
+ Add_Str_To_Name_Buffer ("%b");
+ ALI_Unit := Name_Find;
+ ALI_Name :=
+ Lib_File_Name (Unit.File_Names (Impl).Display_File);
+ ALI_Project := Unit.File_Names (Impl).Project;
+
+ -- Otherwise, if this is a spec and there is no body, put it in
+ -- the mapping.
+
+ elsif Source.Kind = Spec
+ and then Unit.File_Names (Impl) = No_Source
+ and then Unit.File_Names (Spec) /= No_Source
+ and then Unit.File_Names (Spec).Project /= No_Project
+ then
+ Get_Name_String (Unit.Name);
+ Add_Str_To_Name_Buffer ("%s");
+ ALI_Unit := Name_Find;
+ ALI_Name :=
+ Lib_File_Name (Unit.File_Names (Spec).Display_File);
+ ALI_Project := Unit.File_Names (Spec).Project;
- else
- ALI_Name := No_File;
- end if;
+ else
+ ALI_Name := No_File;
+ end if;
- -- If we have something to put in the mapping then do it now.
- -- However, if the project is extended, we don't put anything
- -- in the mapping file, since we don't know where the ALI file
- -- is: it might be in the extended project object directory as
- -- well as in the extending project object directory.
+ -- If we have something to put in the mapping then do it now. If
+ -- the project is extended, look for the ALI file in the project,
+ -- then in the extending projects in order, and use the last one
+ -- found.
- if ALI_Name /= No_File
- and then ALI_Project.Extended_By = No_Project
- and then ALI_Project.Extends = No_Project
- then
- -- First check if the ALI file exists. If it does not, do
- -- not put the unit in the mapping file.
+ if ALI_Name /= No_File then
+ -- Look in the project and the projects that are extending it
+ -- to find the real ALI file.
- declare
- ALI : constant String := Get_Name_String (ALI_Name);
+ declare
+ ALI : constant String := Get_Name_String (ALI_Name);
- begin
+ ALI_Path : Name_Id := No_Name;
+ begin
+ loop
-- For library projects, use the library ALI directory,
-- for other projects, use the object directory.
end if;
Add_Str_To_Name_Buffer (ALI);
+
+ if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
+ ALI_Path := Name_Find;
+ end if;
+
+ ALI_Project := ALI_Project.Extended_By;
+ exit when ALI_Project = No_Project;
+ end loop;
+
+ if ALI_Path /= No_Name then
+ -- First line is the unit name
+
+ Get_Name_String (ALI_Unit);
Add_Char_To_Name_Buffer (ASCII.LF);
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := Bytes = Name_Len;
- declare
- ALI_Path_Name : constant String :=
- Name_Buffer (1 .. Name_Len);
+ exit when not OK;
- begin
- if Is_Regular_File
- (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
- then
- -- First line is the unit name
-
- Get_Name_String (ALI_Unit);
- Add_Char_To_Name_Buffer (ASCII.LF);
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := Bytes = Name_Len;
-
- exit when not OK;
-
- -- Second line it the ALI file name
-
- Get_Name_String (ALI_Name);
- Add_Char_To_Name_Buffer (ASCII.LF);
- Bytes :=
- Write
- (Mapping_FD,
- Name_Buffer (1)'Address,
- Name_Len);
- OK := (Bytes = Name_Len);
-
- exit when not OK;
-
- -- Third line it the ALI path name
-
- Bytes :=
- Write
- (Mapping_FD,
- ALI_Path_Name (1)'Address,
- ALI_Path_Name'Length);
- OK := (Bytes = ALI_Path_Name'Length);
-
- -- If OK is False, it means we were unable to
- -- write a line. No point in continuing with the
- -- other units.
-
- exit when not OK;
- end if;
- end;
- end;
- end if;
+ -- Second line it the ALI file name
+
+ Get_Name_String (ALI_Name);
+ Add_Char_To_Name_Buffer (ASCII.LF);
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := (Bytes = Name_Len);
+
+ exit when not OK;
+
+ -- Third line it the ALI path name
+
+ Get_Name_String (ALI_Path);
+ Add_Char_To_Name_Buffer (ASCII.LF);
+ Bytes :=
+ Write
+ (Mapping_FD,
+ Name_Buffer (1)'Address,
+ Name_Len);
+ OK := (Bytes = Name_Len);
+
+ -- If OK is False, it means we were unable to write a
+ -- line. No point in continuing with the other units.
+
+ exit when not OK;
+ end if;
+ end;
end if;
- Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
+ Next (Iter);
end loop;
Close (Mapping_FD, Status);
-- Set to True if the tool should not have any output if there are no
-- errors or warnings.
- Rational_Profile : Boolean := False;
+ Overriding_Renamings : Boolean := False;
-- GNAT
- -- Set to True to enable compatibility mode with Rational compiler.
+ -- Set to True to enable compatibility mode with Rational compiler, and
+ -- to accept renamings of implicit operations in their own scope.
Replace_In_Comments : Boolean := False;
-- GNATPREP
-- Set_Exit_Status as the last action of the program.
procedure OS_Exit_Through_Exception (Status : Integer);
- pragma No_Return;
+ pragma No_Return (OS_Exit_Through_Exception);
-- Set the Current_Exit_Status, then raise Types.Terminate_Program
type Exit_Code_Type is (
Pragma_Optimize |
Pragma_Optimize_Alignment |
Pragma_Overflow_Mode |
+ Pragma_Overriding_Renamings |
Pragma_Pack |
Pragma_Partition_Elaboration_Policy |
Pragma_Passive |
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
-- Data for the high resolution clock --
----------------------------------------
- -- Declare some pointers to access multi-word data above. This is needed
- -- to workaround a limitation in the GNU/Linker auto-import feature used
- -- to build the GNAT runtime DLLs. In fact the Clock and Monotonic_Clock
- -- routines are inlined and they are using some multi-word variables.
- -- GNU/Linker will fail to auto-import those variables when building
- -- libgnarl.dll. The indirection level introduced here has no measurable
- -- penalties.
-
- type DA is access all Duration;
- -- Use to have indirect access to multi-word variables
-
- type LIA is access all LARGE_INTEGER;
- -- Use to have indirect access to multi-word variables
-
- type LLIA is access all Long_Long_Integer;
- -- Use to have indirect access to multi-word variables
-
Tick_Frequency : aliased LARGE_INTEGER;
- TFA : constant LIA := Tick_Frequency'Access;
-- Holds frequency of high-performance counter used by Clock
-- Windows NT uses a 1_193_182 Hz counter on PCs.
- Base_Ticks : aliased LARGE_INTEGER;
- BTA : constant LIA := Base_Ticks'Access;
+ Base_Ticks : LARGE_INTEGER;
-- Holds the Tick count for the base time
- Base_Monotonic_Ticks : aliased LARGE_INTEGER;
- BMTA : constant LIA := Base_Monotonic_Ticks'Access;
+ Base_Monotonic_Ticks : LARGE_INTEGER;
-- Holds the Tick count for the base monotonic time
- Base_Clock : aliased Duration;
- BCA : constant DA := Base_Clock'Access;
+ Base_Clock : Duration;
-- Holds the current clock for the standard clock's base time
- Base_Monotonic_Clock : aliased Duration;
- BMCA : constant DA := Base_Monotonic_Clock'Access;
+ Base_Monotonic_Clock : Duration;
-- Holds the current clock for monotonic clock's base time
- Base_Time : aliased Long_Long_Integer;
- BTiA : constant LLIA := Base_Time'Access;
+ Base_Time : Long_Long_Integer;
-- Holds the base time used to check for system time change, used with
-- the standard clock.
GetSystemTimeAsFileTime (Now'Access);
Elap_Secs_Sys :=
- Duration (Long_Long_Float (abs (Now - BTiA.all)) /
+ Duration (Long_Long_Float (abs (Now - Base_Time)) /
Hundreds_Nano_In_Sec);
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - BTA.all) /
- Long_Long_Float (TFA.all));
+ Duration (Long_Long_Float (Current_Ticks - Base_Ticks) /
+ Long_Long_Float (Tick_Frequency));
-- If we have a shift of more than Max_Shift seconds we resynchronize
-- the Clock. This is probably due to a manual Clock adjustment, a DST
Get_Base_Time;
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - BTA.all) /
- Long_Long_Float (TFA.all));
+ Duration (Long_Long_Float (Current_Ticks - Base_Ticks) /
+ Long_Long_Float (Tick_Frequency));
end if;
- return BCA.all + Elap_Secs_Tick;
+ return Base_Clock + Elap_Secs_Tick;
end Clock;
-------------------
else
Elap_Secs_Tick :=
- Duration (Long_Long_Float (Current_Ticks - BMTA.all) /
- Long_Long_Float (TFA.all));
- return BMCA.all + Elap_Secs_Tick;
+ Duration (Long_Long_Float (Current_Ticks - Base_Monotonic_Ticks) /
+ Long_Long_Float (Tick_Frequency));
+ return Base_Monotonic_Clock + Elap_Secs_Tick;
end if;
end Monotonic_Clock;
-- Return the Position number within array Discr_Expr of a discriminant
-- D within the discriminant list of the discriminated type T.
+ procedure Process_Discriminant_Expression
+ (Expr : Node_Id;
+ D : Entity_Id);
+ -- If this is a discriminant constraint on a partial view, do not
+ -- generate an overflow check on the discriminant expression. The check
+ -- will be generated when constraining the full view. Otherwise the
+ -- backend creates duplicate symbols for the temporaries corresponding
+ -- to the expressions to be checked, causing spurious assembler errors.
+
------------------
-- Pos_Of_Discr --
------------------
raise Program_Error;
end Pos_Of_Discr;
+ -------------------------------------
+ -- Process_Discriminant_Expression --
+ -------------------------------------
+
+ procedure Process_Discriminant_Expression
+ (Expr : Node_Id;
+ D : Entity_Id)
+ is
+ BDT : constant Entity_Id := Base_Type (Etype (D));
+
+ begin
+ -- If this is a discriminant constraint on a partial view, do
+ -- not generate an overflow on the discriminant expression. The
+ -- check will be generated when constraining the full view.
+
+ if Is_Private_Type (T)
+ and then Present (Full_View (T))
+ then
+ Analyze_And_Resolve (Expr, BDT, Suppress => Overflow_Check);
+
+ else
+ Analyze_And_Resolve (Expr, BDT);
+ end if;
+ end Process_Discriminant_Expression;
+
-- Declarations local to Build_Discriminant_Constraints
Discr : Entity_Id;
Discr_Expr (D) := Error;
else
- Analyze_And_Resolve (Constr, Base_Type (Etype (Discr)));
+ Process_Discriminant_Expression (Constr, Discr);
Discr_Expr (D) := Constr;
end if;
end if;
Discr_Expr (Position) := Expr;
- Analyze_And_Resolve (Expr, Base_Type (Etype (Discr)));
+ Process_Discriminant_Expression (Expr, Discr);
end if;
-- A discriminant association with more than one discriminant
elsif Nkind (Nam) = N_Expanded_Name
and then Entity (Prefix (Nam)) = Current_Scope
and then Chars (Selector_Name (Nam)) = Chars (New_S)
- and then not Rational_Profile
then
- Error_Msg_N ("subprogram cannot rename itself", N);
+ if Overriding_Renamings then
+ null;
+
+ else
+ Error_Msg_NE
+ ("implicit operation& is not visible (RM 8.3 (15))",
+ Nam, Old_S);
+ end if;
end if;
Set_Convention (New_S, Convention (Old_S));
-- argument has the right form then the Mechanism field of Ent is
-- set appropriately.
+ procedure Set_Rational_Profile;
+ -- Activate the set of configuration pragmas and permissions that make
+ -- up the Rational profile.
+
procedure Set_Ravenscar_Profile (N : Node_Id);
-- Activate the set of configuration pragmas and restrictions that make
-- up the Ravenscar Profile. N is the corresponding pragma node, which
end if;
end Set_Mechanism_Value;
+ --------------------------
+ -- Set_Rational_Profile --
+ --------------------------
+
+ -- The Rational profile includes Implicit_Packing, Use_Vads_Size, and
+ -- and extension to the semantics of renaming declarations.
+
+ procedure Set_Rational_Profile is
+ begin
+ Implicit_Packing := True;
+ Overriding_Renamings := True;
+ Use_VADS_Size := True;
+ end Set_Rational_Profile;
+
---------------------------
-- Set_Ravenscar_Profile --
---------------------------
end if;
end Overflow_Mode;
+ when Pragma_Overriding_Renamings =>
+ Overriding_Renamings := True;
+
-------------
-- Ordered --
-------------
N, Warn => Treat_Restrictions_As_Warnings);
elsif Chars (Argx) = Name_Rational then
- Rational_Profile := True;
+ Set_Rational_Profile;
elsif Chars (Argx) = Name_No_Implementation_Extensions then
Set_Profile_Restrictions
-- pragma Rational, for compatibility with foreign compiler
when Pragma_Rational =>
- Rational_Profile := True;
+ Set_Rational_Profile;
-----------------------
-- Relative_Deadline --
Pragma_Optimize => -1,
Pragma_Optimize_Alignment => -1,
Pragma_Overflow_Mode => 0,
+ Pragma_Overriding_Renamings => 0,
Pragma_Ordered => 0,
Pragma_Pack => 0,
Pragma_Page => -1,
if not Analyzed (Expression (Assoc)) then
Comp_Expr :=
New_Copy_Tree (Expression (Assoc));
+ Set_Parent (Comp_Expr, Parent (N));
Preanalyze_Without_Errors (Comp_Expr);
else
Comp_Expr := Expression (Assoc);
Name_Normalize_Scalars : constant Name_Id := N + $;
Name_Optimize_Alignment : constant Name_Id := N + $; -- GNAT
Name_Overflow_Mode : constant Name_Id := N + $; -- GNAT
+ Name_Overriding_Renamings : constant Name_Id := N + $; -- GNAT
Name_Partition_Elaboration_Policy : constant Name_Id := N + $; -- Ada 05
Name_Persistent_BSS : constant Name_Id := N + $; -- GNAT
Name_Polling : constant Name_Id := N + $; -- GNAT
Pragma_Normalize_Scalars,
Pragma_Optimize_Alignment,
Pragma_Overflow_Mode,
+ Pragma_Overriding_Renamings,
Pragma_Partition_Elaboration_Policy,
Pragma_Persistent_BSS,
Pragma_Polling,
projects / gcc.git / commitdiff