+2015-10-16 Arnaud Charlet <charlet@adacore.com>
+
+ * usage.adb, debug.adb, a-except.adb, a-except.ads, a-except-2005.adb,
+ a-except-2005.ads, s-imgrea.adb: Minor code clean ups related to
+ jgnat/dotnet removal.
+
+2015-10-16 Arnaud Charlet <charlet@adacore.com>
+
+ * s-osprim-vxworks.adb, s-osprim-darwin.adb, s-tadeca.adb,
+ s-osprim-unix.adb, s-osprim-solaris.adb, s-osprim-posix.adb,
+ s-osprim.ads (Monotonic_Clock): Removed, unused.
+
+2015-10-16 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb (Try_Object_Operation, Try_One_Interpretation):
+ Do not reset the Obj_Type of the prefix if an interpretation
+ involves an untagged type, to prevent a crash when analyzing an
+ illegal program in All_Errors mode.
+
+2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Expression_With_Actions):
+ Force the evaluation of the expression when its type is Boolean.
+ (Force_Boolean_Evaluation): New routine.
+
+2015-10-16 Bob Duff <duff@adacore.com>
+
+ * sem_util.adb (Has_Discrim_Dep_Array): Remove
+ this function, and the call. No longer needed now that the back
+ end can handle such things. Should result in further speedups
+ in some cases.
+
+2015-10-16 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch13.adb (Build_Predicate_Functions): If expression for
+ predicate is side-effect free, indicate that the predicate
+ function is pure, to allow for optimization of redundant
+ predicate checks.
+
2015-10-16 Arnaud Charlet <charlet@adacore.com>
* checks.adb: Fix typo.
-- The actual Call_Chain routine is separate, so that it can easily
-- be dummied out when no exception traceback information is needed.
- ------------------------------
- -- Current_Target_Exception --
- ------------------------------
-
- function Current_Target_Exception return Exception_Occurrence is
- begin
- return Null_Occurrence;
- end Current_Target_Exception;
-
-------------------
-- EId_To_String --
-------------------
-- Private Subprograms --
-------------------------
- function Current_Target_Exception return Exception_Occurrence;
- pragma Export
- (Ada, Current_Target_Exception,
- "__gnat_current_target_exception");
- -- This routine should return the current raised exception on targets which
- -- have built-in exception handling such as the Java Virtual Machine. For
- -- other targets this routine is simply ignored. Currently, only JGNAT
- -- uses this. See 4jexcept.ads for details. The pragma Export allows this
- -- routine to be accessed elsewhere in the run-time, even though it is in
- -- the private part of this package (it is not allowed to be in the visible
- -- part, since this is set by the reference manual).
-
function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the
-- exception. This is used to implement the Exception_Name function in
-- The actual polling routine is separate, so that it can easily be
-- replaced with a target dependent version.
- ------------------------------
- -- Current_Target_Exception --
- ------------------------------
-
- function Current_Target_Exception return Exception_Occurrence is
- begin
- return Null_Occurrence;
- end Current_Target_Exception;
-
-------------------
-- EId_To_String --
-------------------
-- Private Subprograms --
-------------------------
- function Current_Target_Exception return Exception_Occurrence;
- pragma Export
- (Ada, Current_Target_Exception,
- "__gnat_current_target_exception");
- -- This routine should return the current raised exception on targets
- -- which have built-in exception handling such as the Java Virtual
- -- Machine. For other targets this routine is simply ignored. Currently,
- -- only JGNAT uses this. See 4jexcept.ads for details. The pragma Export
- -- allows this routine to be accessed elsewhere in the run-time, even
- -- though it is in the private part of this package (it is not allowed
- -- to be in the visible part, since this is set by the reference manual).
-
function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the
-- exception. This is used to implement the Exception_Name function in
-- dG Generate all warnings including those normally suppressed
-- dH Hold (kill) call to gigi
-- dI Inhibit internal name numbering in gnatG listing
- -- dJ Output debugging trace info for JGNAT (Java VM version of GNAT)
+ -- dJ
-- dK Kill all error messages
-- dL Output trace information on elaboration checking
-- dM Assume all variables are modified (no current values)
-- is used in the fixed bugs run to minimize system and version
-- dependency in filed -gnatD or -gnatG output.
- -- dJ Generate debugging trace output for the JGNAT back end. This
- -- consists of symbolic Java Byte Code sequences for all generated
- -- classes plus additional information to indicate local variables
- -- and methods.
-
-- dK Kill all error messages. This debug flag suppresses the output
-- of all error messages. It is used in regression tests where the
-- error messages are target dependent and irrelevant.
--------------------------------------
procedure Expand_N_Expression_With_Actions (N : Node_Id) is
+ Acts : constant List_Id := Actions (N);
+
+ procedure Force_Boolean_Evaluation (Expr : Node_Id);
+ -- Force the evaluation of Boolean expression Expr
+
function Process_Action (Act : Node_Id) return Traverse_Result;
-- Inspect and process a single action of an expression_with_actions for
-- transient controlled objects. If such objects are found, the routine
-- generates code to clean them up when the context of the expression is
-- evaluated or elaborated.
+ ------------------------------
+ -- Force_Boolean_Evaluation --
+ ------------------------------
+
+ procedure Force_Boolean_Evaluation (Expr : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Flag_Decl : Node_Id;
+ Flag_Id : Entity_Id;
+
+ begin
+ -- Relocate the expression to the actions list by capturing its value
+ -- in a Boolean flag. Generate:
+ -- Flag : constant Boolean := Expr;
+
+ Flag_Id := Make_Temporary (Loc, 'F');
+
+ Flag_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Flag_Id,
+ Constant_Present => True,
+ Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc),
+ Expression => Relocate_Node (Expr));
+
+ Append (Flag_Decl, Acts);
+ Analyze (Flag_Decl);
+
+ -- Replace the expression with a reference to the flag
+
+ Rewrite (Expression (N), New_Occurrence_Of (Flag_Id, Loc));
+ Analyze (Expression (N));
+ end Force_Boolean_Evaluation;
+
--------------------
-- Process_Action --
--------------------
-- Local variables
- Acts : constant List_Id := Actions (N);
- Expr : constant Node_Id := Expression (N);
- Act : Node_Id;
+ Act : Node_Id;
-- Start of processing for Expand_N_Expression_With_Actions
-- Do not evaluate the expression when it denotes an entity because the
-- expression_with_actions node will be replaced by the reference.
- if Is_Entity_Name (Expr) then
+ if Is_Entity_Name (Expression (N)) then
null;
-- Do not evaluate the expression when there are no actions because the
-- <finalize Trans_Id>
-- in Val end;
- -- It is now safe to finalize the transient controlled object at the end
- -- of the actions list.
+ -- Once this transformation is performed, it is safe to finalize the
+ -- transient controlled object at the end of the actions list.
+
+ -- Note that Force_Evaluation does not remove side effects in operators
+ -- because it assumes that all operands are evaluated and side effect
+ -- free. This is not the case when an operand depends implicitly on the
+ -- transient controlled object through the use of access types.
+
+ elsif Is_Boolean_Type (Etype (Expression (N))) then
+ Force_Boolean_Evaluation (Expression (N));
+
+ -- The expression of an expression_with_actions node may not necessarely
+ -- be Boolean when the node appears in an if expression. In this case do
+ -- the usual forced evaluation to encapsulate potential aliasing.
else
- Force_Evaluation (Expr);
+ Force_Evaluation (Expression (N));
end if;
-- Process all transient controlled objects found within the actions of
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
is
NFrac : constant Natural := Natural'Max (Aft, 1);
Sign : Character;
- X : aliased Long_Long_Float;
- -- This is declared aliased because the expansion of X'Valid passes
- -- X by access and JGNAT requires all access parameters to be aliased.
- -- The Valid attribute probably needs to be handled via a different
- -- expansion for JGNAT, and this use of aliased should be removed
- -- once Valid is handled properly. ???
+ X : Long_Long_Float;
Scale : Integer;
Expon : Integer;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
- ---------------------
- -- Monotonic_Clock --
- ---------------------
-
- function Monotonic_Clock return Duration renames Clock;
-
-----------------
-- To_Timespec --
-----------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
return Duration (sec) + Duration (usec) / Micro;
end Clock;
- ---------------------
- -- Monotonic_Clock --
- ---------------------
-
- function Monotonic_Clock return Duration renames Clock;
-
-----------------
-- To_Timespec --
-----------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
- ---------------------
- -- Monotonic_Clock --
- ---------------------
-
- function Monotonic_Clock return Duration renames Clock;
-
-----------------
-- Timed_Delay --
-----------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock;
- ---------------------
- -- Monotonic_Clock --
- ---------------------
-
- function Monotonic_Clock return Duration renames Clock;
-
-----------------
-- Timed_Delay --
-----------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
end Clock;
- ---------------------
- -- Monotonic_Clock --
- ---------------------
-
- function Monotonic_Clock return Duration renames Clock;
-
-----------------
-- Timed_Delay --
-----------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
-- Epoch", which is Jan 1, 1970 00:00:00 UTC on UNIX systems. This
-- implementation is affected by system's clock changes.
- function Monotonic_Clock return Duration;
- pragma Inline (Monotonic_Clock);
- -- Returns "absolute" time, represented as an offset relative to "the Unix
- -- Epoch", which is Jan 1, 1970 00:00:00 UTC. This clock implementation is
- -- immune to the system's clock changes.
-
Relative : constant := 0;
Absolute_Calendar : constant := 1;
Absolute_RT : constant := 2;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2015, 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- --
if SOSC.CLOCK_RT_Ada /= SOSC.CLOCK_REALTIME then
pragma Warnings (On);
- RT_T := RT_T - OS_Primitives.Monotonic_Clock + STPO.Monotonic_Clock;
+ RT_T := RT_T - OS_Primitives.Clock + STPO.Monotonic_Clock;
end if;
System.Tasking.Initialization.Defer_Abort
Insert_Before_And_Analyze (N, FDecl);
Insert_After_And_Analyze (N, FBody);
+
+ -- Static predicate functions are always side-effect free, and
+ -- in most cases dynamic predicate functions are as well. Mark
+ -- them as such whenever possible, so redundant predicate checks
+ -- can be optimized.
+
+ if Expander_Active then
+ Set_Is_Pure (SId, Side_Effect_Free (Expr));
+ Set_Is_Inlined (SId);
+ end if;
end;
-- Test for raise expressions present and if so build M version
-----------------------------------
procedure Try_One_Prefix_Interpretation (T : Entity_Id) is
+
+ -- If the interpretation does not have a valid candidate type,
+ -- preserve current value of Obj_Type for subsequent errors.
+
+ Prev_Obj_Type : constant Entity_Id := Obj_Type;
+
begin
Obj_Type := T;
if not Is_Tagged_Type (Obj_Type)
or else Is_Incomplete_Type (Obj_Type)
then
+
+ -- Restore previous type if current one is not legal candidate.
+
+ Obj_Type := Prev_Obj_Type;
return;
end if;
-- could be nested inside some other record that is constrained by
-- nondiscriminants). That is, the recursive calls are too conservative.
- function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean;
- -- True if we find certain discriminant-dependent array subcomponents.
- -- This shouldn't be necessary, but without this check, we crash in
- -- gimplify. ???
-
------------------------------
-- Caller_Known_Size_Record --
------------------------------
return True;
end Caller_Known_Size_Record;
- ---------------------------
- -- Has_Discrim_Dep_Array --
- ---------------------------
-
- function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean is
- pragma Assert (Typ = Underlying_Type (Typ));
-
- begin
- if Is_Array_Type (Typ) then
- return Size_Depends_On_Discriminant (Typ);
- end if;
-
- if Is_Record_Type (Typ)
- or else
- Is_Protected_Type (Typ)
- then
- declare
- Comp : Entity_Id;
-
- begin
- Comp := First_Entity (Typ);
- while Present (Comp) loop
-
- -- Only look at E_Component entities. No need to look at
- -- E_Discriminant entities, and we must ignore internal
- -- subtypes generated for constrained components.
-
- if Ekind (Comp) = E_Component then
- declare
- Comp_Type : constant Entity_Id :=
- Underlying_Type (Etype (Comp));
- begin
- if Has_Discrim_Dep_Array (Comp_Type) then
- return True;
- end if;
- end;
- end if;
-
- Next_Entity (Comp);
- end loop;
- end;
- end if;
-
- return False;
- end Has_Discrim_Dep_Array;
-
-- Local declarations
Typ : constant Entity_Id := Underlying_Type (Id);
-- discriminants.
elsif Is_Definite_Subtype (Typ) or else Is_Task_Type (Typ) then
- if Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
- if not Has_Discriminants (Typ) then
- if Has_Discrim_Dep_Array (Typ) then
- return True; -- ???Shouldn't be necessary
- end if;
- end if;
- end if;
-
return False;
-- Indefinite (discriminated) untagged record or protected type
Write_Line ("Preserve control flow for coverage analysis");
end if;
- -- Common switches available to both GCC and JGNAT
+ -- Common switches available everywhere
Write_Switch_Char ("g ", "");
Write_Line ("Generate debugging information");
projects / gcc.git / commitdiff