Skip to content

R
riscv-gcc-1
Commit 980f237d by Geert Bosch
Options

einfo.ads: Minor reformatting 

	* einfo.ads: Minor reformatting

	* exp_ch5.adb: Add comment for previous.change

	* ali.adb: New interface for extended typeref stuff.

	* ali.ads: New interface for typeref stuff.

	* checks.adb (Apply_Alignment_Check): New procedure.

	* debug.adb: Add -gnatdM for modified ALI output

	* exp_pakd.adb (Known_Aligned_Enough): Replaces Known_Aligned_Enough.

	* lib-xref.adb: Extend generation of <..> notation to cover
	subtype/object types. Note that this is a complete rewrite,
	getting rid of the very nasty quadratic algorithm previously
	used for derived type output.

	* lib-xref.ads: Extend description of <..> notation to cover
	subtype/object types. Uses {..} for these other cases.
	Also use (..) for pointer types.

	* sem_util.adb (Check_Potentially_Blocking_Operation): Slight cleanup.

	* exp_pakd.adb: Minor reformatting.  Note that prevous RH should say:
	(Known_Aligned_Enough): Replaces Must_Be_Aligned.

From-SVN: r47896
parent 290986ed
Showing with 449 additions and 117 deletions
gcc/ada/ali.adb
......@@ -133,7 +133,8 @@ package body ALI is
-- If Lower is set to true then the Name_Buffer will be converted to
-- all lower case. This only happends for systems where file names are
-- not case sensitive, and ensures that gnatbind works correctly on
-- such systems, regardless of the case of the file name.
-- such systems, regardless of the case of the file name. Note that
-- a name can be terminated by a right typeref bracket.
function Get_Nat return Nat;
-- Skip blanks, then scan out an unsigned integer value in Nat range
......@@ -305,6 +306,7 @@ package body ALI is
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc;
exit when At_End_Of_Field;
exit when Nextc = ')' or else Nextc = '}' or else Nextc = '>';
end loop;
-- Convert file name to all lower case if file names are not case
......@@ -1253,30 +1255,55 @@ package body ALI is
Skip_Space;
if Nextc = '<' then
P := P + 1;
N := Get_Nat;
case Nextc is
when '<' => XE.Tref := Tref_Derived;
when '(' => XE.Tref := Tref_Access;
when '{' => XE.Tref := Tref_Type;
when others => XE.Tref := Tref_None;
end case;
if Nextc = '|' then
XE.Ptype_File_Num :=
Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
Current_File_Num := XE.Ptype_File_Num;
P := P + 1;
N := Get_Nat;
-- Case of typeref field present
if XE.Tref /= Tref_None then
P := P + 1; -- skip opening bracket
if Nextc in 'a' .. 'z' then
XE.Tref_File_Num := No_Sdep_Id;
XE.Tref_Line := 0;
XE.Tref_Type := ' ';
XE.Tref_Col := 0;
XE.Tref_Standard_Entity := Get_Name;
else
XE.Ptype_File_Num := Current_File_Num;
N := Get_Nat;
if Nextc = '|' then
XE.Tref_File_Num :=
Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
Current_File_Num := XE.Tref_File_Num;
P := P + 1;
N := Get_Nat;
else
XE.Tref_File_Num := Current_File_Num;
end if;
XE.Tref_Line := N;
XE.Tref_Type := Getc;
XE.Tref_Col := Get_Nat;
XE.Tref_Standard_Entity := No_Name;
end if;
XE.Ptype_Line := N;
XE.Ptype_Type := Getc;
XE.Ptype_Col := Get_Nat;
P := P + 1; -- skip closing bracket
-- No typeref entry present
else
XE.Ptype_File_Num := No_Sdep_Id;
XE.Ptype_Line := 0;
XE.Ptype_Type := ' ';
XE.Ptype_Col := 0;
XE.Tref_File_Num := No_Sdep_Id;
XE.Tref_Line := 0;
XE.Tref_Type := ' ';
XE.Tref_Col := 0;
XE.Tref_Standard_Entity := No_Name;
end if;
XE.First_Xref := Xref.Last + 1;
......
gcc/ada/ali.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.71 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -588,6 +588,15 @@ package ALI is
Table_Increment => 300,
Table_Name => "Xref_Section");
-- The following is used to indicate whether a typeref field is present
-- for the entity, and if so what kind of typeref field.
type Tref_Kind is (
Tref_None, -- No typeref present
Tref_Access, -- Access type typeref (points to designated type)
Tref_Derived, -- Derived type typeref (points to parent type)
Tref_Type); -- All other cases
-- The following table records entities for which xrefs are recorded
type Xref_Entity_Record is record
......@@ -607,24 +616,39 @@ package ALI is
Entity : Name_Id;
-- Name of entity
Ptype_File_Num : Sdep_Id;
-- This field is set to No_Sdep_Id if no ptype (parent type) entry
-- is present, otherwise it is the file dependency reference for
-- the parent type declaration.
Ptype_Line : Nat;
-- Set to zero if no ptype (parent type) entry, otherwise this is
-- the line number of the declaration of the parent type.
Ptype_Type : Character;
-- Set to blank if no ptype (parent type) entry, otherwise this is
-- the identification character for the parent type. See section
Tref : Tref_Kind;
-- Indicates if a typeref is present, and if so what kind. Set to
-- Tref_None if no typeref field is present.
Tref_File_Num : Sdep_Id;
-- This field is set to No_Sdep_Id if no typeref is present, or
-- if the typeref refers to an entity in standard. Otherwise it
-- it is the dependency reference for the file containing the
-- declaration of the typeref entity.
Tref_Line : Nat;
-- This field is set to zero if no typeref is present, or if the
-- typeref refers to an entity in standard. Otherwise it contains
-- the line number of the declaration of the typeref entity.
Tref_Type : Character;
-- This field is set to blank if no typeref is present, or if the
-- typeref refers to an entity in standard. Otherwise it contains
-- the identification character for the typeref entity. See section
-- "Cross-Reference Entity Indentifiers in lib-xref.ads for details.
Ptype_Col : Nat;
-- Set to zero if no ptype (parent type) entry, otherwise this is
Tref_Col : Nat;
-- This field is set to zero if no typeref is present, or if the
-- typeref refers to an entity in standard. Otherwise it contains
-- the column number of the declaration of the parent type.
Tref_Standard_Entity : Name_Id;
-- This field is set to No_Name if no typeref is present or if the
-- typeref refers to a declared entity rather than an entity in
-- package Standard. If there is a typeref that references an
-- entity in package Standard, then this field is a Name_Id
-- reference for the entity name.
First_Xref : Nat;
-- Index into Xref table of first cross-reference
......
gcc/ada/checks.adb
......@@ -37,6 +37,7 @@ with Freeze; use Freeze;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Restrict; use Restrict;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
......@@ -277,6 +278,79 @@ package body Checks is
end if;
end Apply_Accessibility_Check;
---------------------------
-- Apply_Alignment_Check --
---------------------------
procedure Apply_Alignment_Check (E : Entity_Id; N : Node_Id) is
AC : constant Node_Id := Address_Clause (E);
Expr : Node_Id;
Loc : Source_Ptr;
begin
if No (AC) or else Range_Checks_Suppressed (E) then
return;
end if;
Loc := Sloc (AC);
Expr := Expression (AC);
if Nkind (Expr) = N_Unchecked_Type_Conversion then
Expr := Expression (Expr);
elsif Nkind (Expr) = N_Function_Call
and then Is_RTE (Entity (Name (Expr)), RE_To_Address)
then
Expr := First (Parameter_Associations (Expr));
if Nkind (Expr) = N_Parameter_Association then
Expr := Explicit_Actual_Parameter (Expr);
end if;
end if;
-- Here Expr is the address value. See if we know that the
-- value is unacceptable at compile time.
if Compile_Time_Known_Value (Expr)
and then Known_Alignment (E)
then
if Expr_Value (Expr) mod Alignment (E) /= 0 then
Insert_Action (N,
Make_Raise_Program_Error (Loc));
Error_Msg_NE
("?specified address for& not " &
"consistent with alignment", Expr, E);
end if;
-- Here we do not know if the value is acceptable, generate
-- code to raise PE if alignment is inappropriate.
else
-- Skip generation of this code if we don't want elab code
if not Restrictions (No_Elaboration_Code) then
Insert_After_And_Analyze (N,
Make_Raise_Program_Error (Loc,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd =>
Make_Op_Mod (Loc,
Left_Opnd =>
Unchecked_Convert_To
(RTE (RE_Integer_Address),
Duplicate_Subexpr (Expr)),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (E, Loc),
Attribute_Name => Name_Alignment)),
Right_Opnd => Make_Integer_Literal (Loc, Uint_0))),
Suppress => All_Checks);
end if;
end if;
return;
end Apply_Alignment_Check;
-------------------------------------
-- Apply_Arithmetic_Overflow_Check --
-------------------------------------
......
gcc/ada/debug.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.88 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -80,7 +80,7 @@ package body Debug is
-- dJ Output debugging trace info for JGNAT (Java VM version of GNAT)
-- dK Kill all error messages
-- dL Output trace information on elaboration checking
-- dM
-- dM Modified ali file output
-- dN Do not generate file/line exception messages
-- dO Output immediate error messages
-- dP Do not check for controlled objects in preelaborable packages
......@@ -284,6 +284,11 @@ package body Debug is
-- attempting to generate code with this flag set may blow up.
-- The flag also forces the use of 64-bits for Long_Integer.
-- dM Generate modified ALI output. Several ALI extensions are being
-- developed for version 3.15w, and this switch is used to enable
-- these extensions. This switch will disappear when this work is
-- completed.
-- dn Generate messages for node/list allocation. Each time a node or
-- list header is allocated, a line of output is generated. Certain
-- other basic tree operations also cause a line of output to be
......
gcc/ada/einfo.ads
......@@ -302,6 +302,7 @@ package Einfo is
-- only if the actual subtype differs from the nominal subtype. If the
-- actual and nominal subtypes are the same, then the Actual_Subtype
-- field is Empty, and Etype indicates both types.
--
-- For objects, the Actual_Subtype is set only if this is a discriminated
-- type. For arrays, the bounds of the expression are obtained and the
-- Etype of the object is directly the constrained subtype. This is
......
gcc/ada/exp_ch5.adb
......@@ -1895,6 +1895,11 @@ package body Exp_Ch5 is
-- the Then statements
else
-- We do not delete the condition if constant condition
-- warnings are enabled, since otherwise we end up deleting
-- the desired warning. Of course the backend will get rid
-- of this True/False test anyway, so nothing is lost here.
if not Constant_Condition_Warnings then
Kill_Dead_Code (Condition (N));
end if;
......
gcc/ada/exp_pakd.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.125 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
......@@ -453,6 +453,16 @@ package body Exp_Pakd is
-- expression whose type is the implementation type used to represent
-- the packed array. Aexp is analyzed and resolved on entry and on exit.
function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean;
-- There are two versions of the Set routines, the ones used when the
-- object is known to be sufficiently well aligned given the number of
-- bits, and the ones used when the object is not known to be aligned.
-- This routine is used to determine which set to use. Obj is a reference
-- to the object, and Csiz is the component size of the packed array.
-- True is returned if the alignment of object is known to be sufficient,
-- defined as 1 for odd bit sizes, 4 for bit sizes divisible by 4, and
-- 2 otherwise.
function Make_Shift_Left (N : Node_Id; S : Node_Id) return Node_Id;
-- Build a left shift node, checking for the case of a shift count of zero
......@@ -1426,7 +1436,7 @@ package body Exp_Pakd is
-- Acquire proper Set entity. We use the aligned or unaligned
-- case as appropriate.
if Must_Be_Aligned (Obj) then
if Known_Aligned_Enough (Obj, Csiz) then
Set_nn := RTE (Set_Id (Csiz));
else
Set_nn := RTE (SetU_Id (Csiz));
......@@ -1816,7 +1826,7 @@ package body Exp_Pakd is
-- Acquire proper Get entity. We use the aligned or unaligned
-- case as appropriate.
if Must_Be_Aligned (Obj) then
if Known_Aligned_Enough (Obj, Csiz) then
Get_nn := RTE (Get_Id (Csiz));
else
Get_nn := RTE (GetU_Id (Csiz));
......@@ -2088,6 +2098,122 @@ package body Exp_Pakd is
end if;
end Involves_Packed_Array_Reference;
--------------------------
-- Known_Aligned_Enough --
--------------------------
function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean is
Typ : constant Entity_Id := Etype (Obj);
function In_Partially_Packed_Record (Comp : Entity_Id) return Boolean;
-- If the component is in a record that contains previous packed
-- components, consider it unaligned because the back-end might
-- choose to pack the rest of the record. Lead to less efficient code,
-- but safer vis-a-vis of back-end choices.
--------------------------------
-- In_Partially_Packed_Record --
--------------------------------
function In_Partially_Packed_Record (Comp : Entity_Id) return Boolean is
Rec_Type : constant Entity_Id := Scope (Comp);
Prev_Comp : Entity_Id;
begin
Prev_Comp := First_Entity (Rec_Type);
while Present (Prev_Comp) loop
if Is_Packed (Etype (Prev_Comp)) then
return True;
elsif Prev_Comp = Comp then
return False;
end if;
Next_Entity (Prev_Comp);
end loop;
return False;
end In_Partially_Packed_Record;
-- Start of processing for Known_Aligned_Enough
begin
-- Odd bit sizes don't need alignment anyway
if Csiz mod 2 = 1 then
return True;
-- If we have a specified alignment, see if it is sufficient, if not
-- then we can't possibly be aligned enough in any case.
elsif Is_Entity_Name (Obj)
and then Known_Alignment (Entity (Obj))
then
-- Alignment required is 4 if size is a multiple of 4, and
-- 2 otherwise (e.g. 12 bits requires 4, 10 bits requires 2)
if Alignment (Entity (Obj)) < 4 - (Csiz mod 4) then
return False;
end if;
end if;
-- OK, alignment should be sufficient, if object is aligned
-- If object is strictly aligned, then it is definitely aligned
if Strict_Alignment (Typ) then
return True;
-- Case of subscripted array reference
elsif Nkind (Obj) = N_Indexed_Component then
-- If we have a pointer to an array, then this is definitely
-- aligned, because pointers always point to aligned versions.
if Is_Access_Type (Etype (Prefix (Obj))) then
return True;
-- Otherwise, go look at the prefix
else
return Known_Aligned_Enough (Prefix (Obj), Csiz);
end if;
-- Case of record field
elsif Nkind (Obj) = N_Selected_Component then
-- What is significant here is whether the record type is packed
if Is_Record_Type (Etype (Prefix (Obj)))
and then Is_Packed (Etype (Prefix (Obj)))
then
return False;
-- Or the component has a component clause which might cause
-- the component to become unaligned (we can't tell if the
-- backend is doing alignment computations).
elsif Present (Component_Clause (Entity (Selector_Name (Obj)))) then
return False;
elsif In_Partially_Packed_Record (Entity (Selector_Name (Obj))) then
return False;
-- In all other cases, go look at prefix
else
return Known_Aligned_Enough (Prefix (Obj), Csiz);
end if;
-- If not selected or indexed component, must be aligned
else
return True;
end if;
end Known_Aligned_Enough;
---------------------
-- Make_Shift_Left --
---------------------
......@@ -2184,6 +2310,7 @@ package body Exp_Pakd is
-- All we have to do here is to find the subscripts that correspond
-- to the index positions that have non-standard enumeration types
-- and insert a Pos attribute to get the proper subscript value.
-- Finally the prefix must be uncheck converted to the corresponding
-- packed array type.
......
gcc/ada/lib-xref.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.56 $
-- $Revision$
-- --
-- Copyright (C) 1998-2001, Free Software Foundation, Inc. --
-- --
......@@ -28,6 +28,7 @@
with Atree; use Atree;
with Csets; use Csets;
with Debug; use Debug;
with Lib.Util; use Lib.Util;
with Namet; use Namet;
with Opt; use Opt;
......@@ -84,10 +85,6 @@ package body Lib.Xref is
Table_Increment => Alloc.Xrefs_Increment,
Table_Name => "Xrefs");
function Get_Xref_Index (E : Entity_Id) return Xref_Entry_Number;
-- Returns the Xref entry table index for entity E.
-- So : Xrefs.Table (Get_Xref_Index (E)).Ent = E
-------------------------
-- Generate_Definition --
-------------------------
......@@ -328,23 +325,6 @@ package body Lib.Xref is
end if;
end Generate_Reference;
--------------------
-- Get_Xref_Index --
--------------------
function Get_Xref_Index (E : Entity_Id) return Xref_Entry_Number is
begin
for K in 1 .. Xrefs.Last loop
if Xrefs.Table (K).Ent = E then
return K;
end if;
end loop;
-- not found, this happend if the entity is not in the compiled unit.
return 0;
end Get_Xref_Index;
-----------------------
-- Output_References --
-----------------------
......@@ -466,35 +446,18 @@ package body Lib.Xref is
Ctyp : Character;
-- Entity type character
Parent_Entry : Int;
-- entry for parent of derived type.
Tref : Entity_Id;
-- Type reference
Trunit : Unit_Number_Type;
-- Unit number for type reference
function Name_Change (X : Entity_Id) return Boolean;
-- Determines if entity X has a different simple name from Curent
function Get_Parent_Entry (X : Entity_Id) return Int;
-- For a derived type, locate entry of parent type, if defined in
-- in the current unit.
function Get_Parent_Entry (X : Entity_Id) return Int is
Parent_Type : Entity_Id;
begin
if not Is_Type (X)
or else not Is_Derived_Type (X)
then
return 0;
else
Parent_Type := First_Subtype (Etype (Base_Type (X)));
if Comes_From_Source (Parent_Type) then
return Get_Xref_Index (Parent_Type);
else
return 0;
end if;
end if;
end Get_Parent_Entry;
-----------------
-- Name_Change --
-----------------
function Name_Change (X : Entity_Id) return Boolean is
begin
......@@ -529,6 +492,11 @@ package body Lib.Xref is
WC : Char_Code;
Err : Boolean;
Ent : Entity_Id;
Sav : Entity_Id;
Left : Character;
Right : Character;
-- Used for {} or <> for type reference
begin
Ent := XE.Ent;
......@@ -709,34 +677,123 @@ package body Lib.Xref is
end loop;
end if;
-- Output derived entity name if it is available
-- Output type reference if any
Tref := XE.Ent;
Left := '{';
Right := '}';
loop
Sav := Tref;
-- Processing for types
if Is_Type (Tref) then
-- Case of base type
if Base_Type (Tref) = Tref then
-- If derived, then get first subtype
if Tref /= Etype (Tref) then
Tref := First_Subtype (Etype (Tref));
Left := '<';
Right := '>';
Parent_Entry := Get_Parent_Entry (XE.Ent);
-- If non-derived ptr, get designated type
if Parent_Entry /= 0 then
declare
XD : Xref_Entry renames Xrefs.Table (Parent_Entry);
elsif Is_Access_Type (Tref) then
Tref := Designated_Type (Tref);
Left := '(';
Right := ')';
begin
Write_Info_Char ('<');
-- For other non-derived base types, nothing
-- Write unit number only if different from the
-- current one.
else
exit;
end if;
if XE.Eun /= XD.Eun then
Write_Info_Nat (Dependency_Num (XD.Eun));
-- For a subtype, go to ancestor subtype
else
Tref := Ancestor_Subtype (Tref);
-- If no ancestor subtype, go to base type
if No (Tref) then
Tref := Base_Type (Sav);
end if;
end if;
-- For objects, functions, enum literals,
-- just get type from Etype field.
elsif Is_Object (Tref)
or else Ekind (Tref) = E_Enumeration_Literal
or else Ekind (Tref) = E_Function
or else Ekind (Tref) = E_Operator
then
Tref := Etype (Tref);
-- For anything else, exit
else
exit;
end if;
-- Exit if no type reference, or we are stuck in
-- some loop trying to find the type reference.
exit when No (Tref) or else Tref = Sav;
-- Case of standard entity, output name
if Sloc (Tref) = Standard_Location then
-- For now, output only if speial -gnatdM flag set
exit when not Debug_Flag_MM;
Write_Info_Char (Left);
Write_Info_Name (Chars (Tref));
Write_Info_Char (Right);
exit;
-- Case of source entity, output location
elsif Comes_From_Source (Tref) then
-- For now, output only derived type entries
-- unless we have special debug flag -gnatdM
exit when not (Debug_Flag_MM or else Left = '<');
-- Output the reference
Write_Info_Char (Left);
Trunit := Get_Source_Unit (Sloc (Tref));
if Trunit /= Curxu then
Write_Info_Nat (Dependency_Num (Trunit));
Write_Info_Char ('|');
end if;
Write_Info_Nat
(Int (Get_Logical_Line_Number (XD.Def)));
(Int (Get_Logical_Line_Number (Sloc (Tref))));
Write_Info_Char
(Xref_Entity_Letters (Ekind (XD.Ent)));
Write_Info_Nat (Int (Get_Column_Number (XD.Def)));
(Xref_Entity_Letters (Ekind (Tref)));
Write_Info_Nat
(Int (Get_Column_Number (Sloc (Tref))));
Write_Info_Char (Right);
exit;
Write_Info_Char ('>');
end;
end if;
-- If non-standard, non-source entity, keep looking
else
null;
end if;
end loop;
Curru := Curxu;
Crloc := No_Location;
......
gcc/ada/lib-xref.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- $Revision: 1.31 $
-- $Revision$
-- --
-- Copyright (C) 1998-2001, Free Software Foundation, Inc. --
-- --
......@@ -56,7 +56,7 @@ package Lib.Xref is
--
-- The lines following the header look like
--
-- line type col level entity ptype ref ref ref
-- line type col level entity typeref ref ref ref
--
-- line is the line number of the referenced entity. It starts
-- in column one.
......@@ -74,17 +74,30 @@ package Lib.Xref is
-- entity is the name of the referenced entity, with casing in
-- the canical casing for the source file where it is defined.
--
-- ptype is the parent's entity reference. This part is optional (it
-- is only set for derived types) and has the following format:
--
-- < file | line type col >
--
-- file is the dependency number of the file containing the
-- declaration of the parent type. This number and the following
-- vertical bar are omitted if the parent type is defined in the
-- same file as the derived type. The line, type, col are defined
-- as previously described, and give the location of the parent
-- type declaration in the referenced file.
-- typeref is the reference for the type. This part is optional.
-- It is present for the following cases:
--
-- derived types (points to the parent type) LR=<>
-- access types (points to designated type) LR=()
-- subtypes (points to ancestor type) LR={}
-- functions (points to result type) LR={}
-- enumeration literals (points to enum type) LR={}
-- objects and components (points to type) LR={}
--
-- In the above list LR shows the brackets used in the output,
-- which has one of the two following forms:
--
-- L file | line type col R user entity
-- L name-in-lower-case R standard entity
--
-- For the form for a user entity, file is the dependency number
-- of the file containing the declaration of the parent type. This
-- number and the following vertical bar are omitted if the relevant
-- type is defined in the same file as the current entity. The line,
-- type, col are defined as previously described, and specify the
-- location of the relevant type declaration in the referenced file.
-- For the standard entity form, the name between the brackets is
-- the normal name of the entity in lower case letters.
--
-- There may be zero or more ref entries on each line
--
......
gcc/ada/sem_util.adb
......@@ -720,8 +720,7 @@ package body Sem_Util is
if Is_Protected_Type (S) then
if Restricted_Profile then
Insert_Before (N,
Make_Raise_Statement (Loc,
Name => New_Occurrence_Of (Standard_Program_Error, Loc)));
Make_Raise_Program_Error (Loc));
Error_Msg_N ("potentially blocking operation, " &
" Program Error will be raised at run time?", N);
......
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