Commit e3d9f448 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r228881
parent 57d3adcd
2015-10-16 Arnaud Charlet <charlet@adacore.com> 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. * checks.adb: Fix typo.
* s-osinte-linux.ads: Add header. * s-osinte-linux.ads: Add header.
* projects.texi: Removed, no longer used. * projects.texi: Removed, no longer used.
......
...@@ -694,15 +694,6 @@ package body Ada.Exceptions is ...@@ -694,15 +694,6 @@ package body Ada.Exceptions is
-- The actual Call_Chain routine is separate, so that it can easily -- The actual Call_Chain routine is separate, so that it can easily
-- be dummied out when no exception traceback information is needed. -- 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 -- -- EId_To_String --
------------------- -------------------
......
...@@ -177,18 +177,6 @@ private ...@@ -177,18 +177,6 @@ private
-- Private Subprograms -- -- 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; function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the -- Like Exception_Name, but returns the simple non-qualified name of the
-- exception. This is used to implement the Exception_Name function in -- exception. This is used to implement the Exception_Name function in
......
...@@ -727,15 +727,6 @@ package body Ada.Exceptions is ...@@ -727,15 +727,6 @@ package body Ada.Exceptions is
-- The actual polling routine is separate, so that it can easily be -- The actual polling routine is separate, so that it can easily be
-- replaced with a target dependent version. -- 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 -- -- EId_To_String --
------------------- -------------------
......
...@@ -154,18 +154,6 @@ private ...@@ -154,18 +154,6 @@ private
-- Private Subprograms -- -- 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; function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of the -- Like Exception_Name, but returns the simple non-qualified name of the
-- exception. This is used to implement the Exception_Name function in -- exception. This is used to implement the Exception_Name function in
......
...@@ -73,7 +73,7 @@ package body Debug is ...@@ -73,7 +73,7 @@ package body Debug is
-- dG Generate all warnings including those normally suppressed -- dG Generate all warnings including those normally suppressed
-- dH Hold (kill) call to gigi -- dH Hold (kill) call to gigi
-- dI Inhibit internal name numbering in gnatG listing -- 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 -- dK Kill all error messages
-- dL Output trace information on elaboration checking -- dL Output trace information on elaboration checking
-- dM Assume all variables are modified (no current values) -- dM Assume all variables are modified (no current values)
...@@ -399,11 +399,6 @@ package body Debug is ...@@ -399,11 +399,6 @@ package body Debug is
-- is used in the fixed bugs run to minimize system and version -- is used in the fixed bugs run to minimize system and version
-- dependency in filed -gnatD or -gnatG output. -- 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 -- dK Kill all error messages. This debug flag suppresses the output
-- of all error messages. It is used in regression tests where the -- of all error messages. It is used in regression tests where the
-- error messages are target dependent and irrelevant. -- error messages are target dependent and irrelevant.
......
...@@ -5039,12 +5039,49 @@ package body Exp_Ch4 is ...@@ -5039,12 +5039,49 @@ package body Exp_Ch4 is
-------------------------------------- --------------------------------------
procedure Expand_N_Expression_With_Actions (N : Node_Id) is 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; function Process_Action (Act : Node_Id) return Traverse_Result;
-- Inspect and process a single action of an expression_with_actions for -- Inspect and process a single action of an expression_with_actions for
-- transient controlled objects. If such objects are found, the routine -- transient controlled objects. If such objects are found, the routine
-- generates code to clean them up when the context of the expression is -- generates code to clean them up when the context of the expression is
-- evaluated or elaborated. -- 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 -- -- Process_Action --
-------------------- --------------------
...@@ -5077,9 +5114,7 @@ package body Exp_Ch4 is ...@@ -5077,9 +5114,7 @@ package body Exp_Ch4 is
-- Local variables -- Local variables
Acts : constant List_Id := Actions (N); Act : Node_Id;
Expr : constant Node_Id := Expression (N);
Act : Node_Id;
-- Start of processing for Expand_N_Expression_With_Actions -- Start of processing for Expand_N_Expression_With_Actions
...@@ -5087,7 +5122,7 @@ package body Exp_Ch4 is ...@@ -5087,7 +5122,7 @@ package body Exp_Ch4 is
-- Do not evaluate the expression when it denotes an entity because the -- Do not evaluate the expression when it denotes an entity because the
-- expression_with_actions node will be replaced by the reference. -- expression_with_actions node will be replaced by the reference.
if Is_Entity_Name (Expr) then if Is_Entity_Name (Expression (N)) then
null; null;
-- Do not evaluate the expression when there are no actions because the -- Do not evaluate the expression when there are no actions because the
...@@ -5117,11 +5152,23 @@ package body Exp_Ch4 is ...@@ -5117,11 +5152,23 @@ package body Exp_Ch4 is
-- <finalize Trans_Id> -- <finalize Trans_Id>
-- in Val end; -- in Val end;
-- It is now safe to finalize the transient controlled object at the end -- Once this transformation is performed, it is safe to finalize the
-- of the actions list. -- 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 else
Force_Evaluation (Expr); Force_Evaluation (Expression (N));
end if; end if;
-- Process all transient controlled objects found within the actions of -- Process all transient controlled objects found within the actions of
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -147,12 +147,7 @@ package body System.Img_Real is ...@@ -147,12 +147,7 @@ package body System.Img_Real is
is is
NFrac : constant Natural := Natural'Max (Aft, 1); NFrac : constant Natural := Natural'Max (Aft, 1);
Sign : Character; Sign : Character;
X : aliased Long_Long_Float; X : 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. ???
Scale : Integer; Scale : Integer;
Expon : Integer; Expon : Integer;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -90,12 +90,6 @@ package body System.OS_Primitives is ...@@ -90,12 +90,6 @@ package body System.OS_Primitives is
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock; end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
----------------- -----------------
-- To_Timespec -- -- To_Timespec --
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -93,12 +93,6 @@ package body System.OS_Primitives is ...@@ -93,12 +93,6 @@ package body System.OS_Primitives is
return Duration (sec) + Duration (usec) / Micro; return Duration (sec) + Duration (usec) / Micro;
end Clock; end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
----------------- -----------------
-- To_Timespec -- -- To_Timespec --
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -70,12 +70,6 @@ package body System.OS_Primitives is ...@@ -70,12 +70,6 @@ package body System.OS_Primitives is
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock; end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
----------------- -----------------
-- Timed_Delay -- -- Timed_Delay --
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -70,12 +70,6 @@ package body System.OS_Primitives is ...@@ -70,12 +70,6 @@ package body System.OS_Primitives is
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6; return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end Clock; end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
----------------- -----------------
-- Timed_Delay -- -- Timed_Delay --
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -102,12 +102,6 @@ package body System.OS_Primitives is ...@@ -102,12 +102,6 @@ package body System.OS_Primitives is
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9; return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
end Clock; end Clock;
---------------------
-- Monotonic_Clock --
---------------------
function Monotonic_Clock return Duration renames Clock;
----------------- -----------------
-- Timed_Delay -- -- Timed_Delay --
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -63,12 +63,6 @@ package System.OS_Primitives is ...@@ -63,12 +63,6 @@ package System.OS_Primitives is
-- Epoch", which is Jan 1, 1970 00:00:00 UTC on UNIX systems. This -- Epoch", which is Jan 1, 1970 00:00:00 UTC on UNIX systems. This
-- implementation is affected by system's clock changes. -- 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; Relative : constant := 0;
Absolute_Calendar : constant := 1; Absolute_Calendar : constant := 1;
Absolute_RT : constant := 2; Absolute_RT : constant := 2;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -66,7 +66,7 @@ begin ...@@ -66,7 +66,7 @@ begin
if SOSC.CLOCK_RT_Ada /= SOSC.CLOCK_REALTIME then if SOSC.CLOCK_RT_Ada /= SOSC.CLOCK_REALTIME then
pragma Warnings (On); 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; end if;
System.Tasking.Initialization.Defer_Abort System.Tasking.Initialization.Defer_Abort
......
...@@ -8702,6 +8702,16 @@ package body Sem_Ch13 is ...@@ -8702,6 +8702,16 @@ package body Sem_Ch13 is
Insert_Before_And_Analyze (N, FDecl); Insert_Before_And_Analyze (N, FDecl);
Insert_After_And_Analyze (N, FBody); 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; end;
-- Test for raise expressions present and if so build M version -- Test for raise expressions present and if so build M version
......
...@@ -8135,6 +8135,12 @@ package body Sem_Ch4 is ...@@ -8135,6 +8135,12 @@ package body Sem_Ch4 is
----------------------------------- -----------------------------------
procedure Try_One_Prefix_Interpretation (T : Entity_Id) is 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 begin
Obj_Type := T; Obj_Type := T;
...@@ -8167,6 +8173,10 @@ package body Sem_Ch4 is ...@@ -8167,6 +8173,10 @@ package body Sem_Ch4 is
if not Is_Tagged_Type (Obj_Type) if not Is_Tagged_Type (Obj_Type)
or else Is_Incomplete_Type (Obj_Type) or else Is_Incomplete_Type (Obj_Type)
then then
-- Restore previous type if current one is not legal candidate.
Obj_Type := Prev_Obj_Type;
return; return;
end if; end if;
......
...@@ -17020,11 +17020,6 @@ package body Sem_Util is ...@@ -17020,11 +17020,6 @@ package body Sem_Util is
-- could be nested inside some other record that is constrained by -- could be nested inside some other record that is constrained by
-- nondiscriminants). That is, the recursive calls are too conservative. -- 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 -- -- Caller_Known_Size_Record --
------------------------------ ------------------------------
...@@ -17077,52 +17072,6 @@ package body Sem_Util is ...@@ -17077,52 +17072,6 @@ package body Sem_Util is
return True; return True;
end Caller_Known_Size_Record; 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 -- Local declarations
Typ : constant Entity_Id := Underlying_Type (Id); Typ : constant Entity_Id := Underlying_Type (Id);
...@@ -17170,14 +17119,6 @@ package body Sem_Util is ...@@ -17170,14 +17119,6 @@ package body Sem_Util is
-- discriminants. -- discriminants.
elsif Is_Definite_Subtype (Typ) or else Is_Task_Type (Typ) then 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; return False;
-- Indefinite (discriminated) untagged record or protected type -- Indefinite (discriminated) untagged record or protected type
......
...@@ -104,7 +104,7 @@ begin ...@@ -104,7 +104,7 @@ begin
Write_Line ("Preserve control flow for coverage analysis"); Write_Line ("Preserve control flow for coverage analysis");
end if; end if;
-- Common switches available to both GCC and JGNAT -- Common switches available everywhere
Write_Switch_Char ("g ", ""); Write_Switch_Char ("g ", "");
Write_Line ("Generate debugging information"); Write_Line ("Generate debugging information");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment