OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* sinput.ads: Minor comment fix.

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, case First_Bit,
	Last_Bit, Position): Handle 2005 case.

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* s-atocou-builtin.adb (Decrement): Use Unrestricted_Access
	to deal with fact that we properly detect the error if Access
	is used.
	(Increment): Same fix.
	* s-taprop-linux.adb (Create_Task): Use Unrestricted_Access
	to deal with fact that we properly detect the error if Access
	is used.
	* sem_util.adb (Is_Volatile_Object): Properly record that A.B is
	volatile if the B component is volatile. This affects the check
	for passing such a by reference volatile actual to a non-volatile
	formal (which should be illegal)

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Enumeration_Type): Make sure to set both
	size and alignment for foreign convention enumeration types.
	* layout.adb (Set_Elem_Alignment): Redo setting of alignment
	when size is set.

2011-11-21  Yannick Moy  <moy@adacore.com>

	* checks.adb (Apply_Access_Check, Apply_Arithmetic_Overflow_Check,
	Apply_Discriminant_Check, Apply_Divide_Check,
	Apply_Selected_Length_Checks, Apply_Selected_Range_Checks,
	Build_Discriminant_Checks, Insert_Range_Checks, Selected_Length_Checks,
	Selected_Range_Checks): Replace reference to Expander_Active
	with reference to Full_Expander_Active, so that expansion of
	checks is not performed in Alfa mode

2011-11-21  Tristan Gingold  <gingold@adacore.com>

	* s-taprop-vms.adb (Create_Task): Use Unrestricted_Access to deal with
	fact that we properly detect the error if Access is used.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch4.adb (P_Quantified_Expression): Add an Ada 2012 check.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_imgv.adb: Add with and use clause for Errout.
	(Expand_Width_Attribute): Emit a warning when in
	configurable run-time mode to provide a better diagnostic message.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-finmas.adb (Finalize): Add comment concerning double finalization.

2011-11-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Definition): If the access definition
	is itself the return type of an access to function definition
	which is ultimately the return type of an access to subprogram
	declaration, its scope is the enclosing scope of the ultimate
	access to subprogram.

2011-11-21  Steve Baird  <baird@adacore.com>

	* sem_res.adb (Valid_Conversion): If a conversion was legal
	in the body of a generic, then the corresponding conversion is
	legal in the expanded body of an instance of the generic.

From-SVN: r181568
This commit is contained in:
Arnaud Charlet 2011-11-21 12:59:08 +01:00
parent 8e0aa19b43
commit be482a8c83
15 changed files with 340 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
gcc/ada/ChangeLog
View File

@ -1,3 +1,76 @@
2011-11-21 Robert Dewar <dewar@adacore.com>
* sinput.ads: Minor comment fix.
2011-11-21 Robert Dewar <dewar@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference, case First_Bit,
Last_Bit, Position): Handle 2005 case.
2011-11-21 Robert Dewar <dewar@adacore.com>
* s-atocou-builtin.adb (Decrement): Use Unrestricted_Access
to deal with fact that we properly detect the error if Access
is used.
(Increment): Same fix.
* s-taprop-linux.adb (Create_Task): Use Unrestricted_Access
to deal with fact that we properly detect the error if Access
is used.
* sem_util.adb (Is_Volatile_Object): Properly record that A.B is
volatile if the B component is volatile. This affects the check
for passing such a by reference volatile actual to a non-volatile
formal (which should be illegal)
2011-11-21 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Enumeration_Type): Make sure to set both
size and alignment for foreign convention enumeration types.
* layout.adb (Set_Elem_Alignment): Redo setting of alignment
when size is set.
2011-11-21 Yannick Moy <moy@adacore.com>
* checks.adb (Apply_Access_Check, Apply_Arithmetic_Overflow_Check,
Apply_Discriminant_Check, Apply_Divide_Check,
Apply_Selected_Length_Checks, Apply_Selected_Range_Checks,
Build_Discriminant_Checks, Insert_Range_Checks, Selected_Length_Checks,
Selected_Range_Checks): Replace reference to Expander_Active
with reference to Full_Expander_Active, so that expansion of
checks is not performed in Alfa mode
2011-11-21 Tristan Gingold <gingold@adacore.com>
* s-taprop-vms.adb (Create_Task): Use Unrestricted_Access to deal with
fact that we properly detect the error if Access is used.
2011-11-21 Hristian Kirtchev <kirtchev@adacore.com>
* par-ch4.adb (P_Quantified_Expression): Add an Ada 2012 check.
2011-11-21 Hristian Kirtchev <kirtchev@adacore.com>
* exp_imgv.adb: Add with and use clause for Errout.
(Expand_Width_Attribute): Emit a warning when in
configurable run-time mode to provide a better diagnostic message.
2011-11-21 Hristian Kirtchev <kirtchev@adacore.com>
* s-finmas.adb (Finalize): Add comment concerning double finalization.
2011-11-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Access_Definition): If the access definition
is itself the return type of an access to function definition
which is ultimately the return type of an access to subprogram
declaration, its scope is the enclosing scope of the ultimate
access to subprogram.
2011-11-21 Steve Baird <baird@adacore.com>
* sem_res.adb (Valid_Conversion): If a conversion was legal
in the body of a generic, then the corresponding conversion is
legal in the expanded body of an instance of the generic.
2011-11-21 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor reformatting.

18
gcc/ada/checks.adb
View File

@ -442,7 +442,7 @@ package body Checks is
-- are cases (e.g. with pragma Debug) where generating the checks
-- can cause real trouble).
if not Expander_Active then
if not Full_Expander_Active then
return;
end if;
@ -878,7 +878,7 @@ package body Checks is
if Backend_Overflow_Checks_On_Target
or else not Do_Overflow_Check (N)
or else not Expander_Active
or else not Full_Expander_Active
or else (Present (Parent (N))
and then Nkind (Parent (N)) = N_Type_Conversion
and then Integer_Promotion_Possible (Parent (N)))
@ -1178,7 +1178,7 @@ package body Checks is
-- Nothing to do if discriminant checks are suppressed or else no code
-- is to be generated
if not Expander_Active
if not Full_Expander_Active
or else Discriminant_Checks_Suppressed (T_Typ)
then
return;
@ -1462,7 +1462,7 @@ package body Checks is
-- Don't actually use this value
begin
if Expander_Active
if Full_Expander_Active
and then not Backend_Divide_Checks_On_Target
and then Check_Needed (Right, Division_Check)
then
@ -2118,7 +2118,7 @@ package body Checks is
(not Length_Checks_Suppressed (Target_Typ));
begin
if not Expander_Active then
if not Full_Expander_Active then
return;
end if;
@ -2226,7 +2226,7 @@ package body Checks is
(not Range_Checks_Suppressed (Target_Typ));
begin
if not Expander_Active or else not Checks_On then
if not Full_Expander_Active or else not Checks_On then
return;
end if;
@ -5309,7 +5309,7 @@ package body Checks is
-- enhanced to check for an always True value in the condition and to
-- generate a compilation warning???
if not Expander_Active or else not Checks_On then
if not Full_Expander_Active or else not Checks_On then
return;
end if;
@ -6236,7 +6236,7 @@ package body Checks is
-- Start of processing for Selected_Length_Checks
begin
if not Expander_Active then
if not Full_Expander_Active then
return Ret_Result;
end if;
@ -6810,7 +6810,7 @@ package body Checks is
-- Start of processing for Selected_Range_Checks
begin
if not Expander_Active then
if not Full_Expander_Active then
return Ret_Result;
end if;

80
gcc/ada/exp_attr.adb
View File

@ -2117,21 +2117,38 @@ package body Exp_Attr is
-- computation to be completed in the back-end, since we don't know what
-- layout will be chosen.
when Attribute_First_Bit => First_Bit : declare
when Attribute_First_Bit => First_Bit_Attr : declare
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
if Known_Static_Component_Bit_Offset (CE) then
-- In Ada 2005 (or later) if we have the standard nondefault
-- bit order, then we return the original value as given in
-- the component clause (RM 2005 13.5.2(3/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then not Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (First_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
-- Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE) then
Rewrite (N,
Make_Integer_Literal (Loc,
Component_Bit_Offset (CE) mod System_Storage_Unit));
Analyze_And_Resolve (N, Typ);
-- Otherwise left to back end, just do universal integer checks
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end First_Bit;
end First_Bit_Attr;
-----------------
-- Fixed_Value --
@ -2680,24 +2697,41 @@ package body Exp_Attr is
-- the computation up to the back end, since we don't know what layout
-- will be chosen.
when Attribute_Last_Bit => Last_Bit : declare
when Attribute_Last_Bit => Last_Bit_Attr : declare
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
if Known_Static_Component_Bit_Offset (CE)
-- In Ada 2005 (or later) if we have the standard nondefault
-- bit order, then we return the original value as given in
-- the component clause (RM 2005 13.5.2(4/2)).
if Present (Component_Clause (CE))
and then Ada_Version >= Ada_2005
and then not Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Last_Bit (Component_Clause (CE)))));
Analyze_And_Resolve (N, Typ);
-- Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
-- rewrite with normalized value if we know it statically.
elsif Known_Static_Component_Bit_Offset (CE)
and then Known_Static_Esize (CE)
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => (Component_Bit_Offset (CE) mod System_Storage_Unit)
+ Esize (CE) - 1));
Analyze_And_Resolve (N, Typ);
-- Otherwise leave to back end, just apply universal integer checks
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end Last_Bit;
end Last_Bit_Attr;
------------------
-- Leading_Part --
@ -3495,21 +3529,41 @@ package body Exp_Attr is
-- the computation up to the back end, since we don't know what layout
-- will be chosen.
when Attribute_Position => Position :
when Attribute_Position => Position_Attr :
declare
CE : constant Entity_Id := Entity (Selector_Name (Pref));
begin
if Present (Component_Clause (CE)) then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Component_Bit_Offset (CE) / System_Storage_Unit));
-- In Ada 2005 (or later) if we have the standard nondefault
-- bit order, then we return the original value as given in
-- the component clause (RM 2005 13.5.2(2/2)).
if Ada_Version >= Ada_2005
and then not Reverse_Bit_Order (Scope (CE))
then
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Expr_Value (Position (Component_Clause (CE)))));
-- Otherwise (Ada 83 or 95, or reverse bit order specified in
-- later Ada version), return the normalized value.
else
Rewrite (N,
Make_Integer_Literal (Loc,
Intval => Component_Bit_Offset (CE) / System_Storage_Unit));
end if;
Analyze_And_Resolve (N, Typ);
-- If back end is doing things, just apply universal integer checks
else
Apply_Universal_Integer_Attribute_Checks (N);
end if;
end Position;
end Position_Attr;
----------
-- Pred --

19
gcc/ada/exp_imgv.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -27,6 +27,7 @@ with Atree; use Atree;
with Casing; use Casing;
with Checks; use Checks;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Util; use Exp_Util;
with Lib; use Lib;
with Namet; use Namet;
@ -1065,10 +1066,10 @@ package body Exp_Imgv is
Pref : constant Node_Id := Prefix (N);
Ptyp : constant Entity_Id := Etype (Pref);
Rtyp : constant Entity_Id := Root_Type (Ptyp);
XX : RE_Id;
YY : Entity_Id;
Arglist : List_Id;
Ttyp : Entity_Id;
XX : RE_Id;
YY : Entity_Id;
begin
-- Types derived from Standard.Boolean
@ -1157,6 +1158,18 @@ package body Exp_Imgv is
if Discard_Names (Rtyp) then
-- Emit a detailed warning in configurable run-time mode because
-- loading RE_Null does not give a precise indication of the real
-- issue.
if Configurable_Run_Time_Mode
and then not Has_Warnings_Off (Rtyp)
then
Error_Msg_Name_1 := Attribute_Name (N);
Error_Msg_N ("?attribute % not supported in configurable " &
"run-time mode", N);
end if;
-- This is a configurable run-time, or else a restriction is in
-- effect. In either case the attribute cannot be supported. Force
-- a load error from Rtsfind to generate an appropriate message,

4
gcc/ada/freeze.adb
View File

@ -4239,7 +4239,8 @@ package body Freeze is
-- By default, if no size clause is present, an enumeration type with
-- Convention C is assumed to interface to a C enum, and has integer
-- size. This applies to types. For subtypes, verify that its base
-- type has no size clause either.
-- type has no size clause either. Treat other foreign conventions
-- in the same way, and also make sure alignment is set right.
if Has_Foreign_Convention (Typ)
and then not Has_Size_Clause (Typ)
@ -4247,6 +4248,7 @@ package body Freeze is
and then Esize (Typ) < Standard_Integer_Size
then
Init_Esize (Typ, Standard_Integer_Size);
Set_Alignment (Typ, Alignment (Standard_Integer));
else
-- If the enumeration type interfaces to C, and it has a size clause

108
gcc/ada/layout.adb
View File

@ -3088,7 +3088,7 @@ package body Layout is
end if;
-- Here we calculate the alignment as the largest power of two multiple
-- of System.Storage_Unit that does not exceed either the actual size of
-- of System.Storage_Unit that does not exceed either the object size of
-- the type, or the maximum allowed alignment.
declare
@ -3126,21 +3126,101 @@ package body Layout is
A := 2 * A;
end loop;
-- Now we think we should set the alignment to A, but we skip this if
-- an alignment is already set to a value greater than A (happens for
-- derived types).
-- If alignment is currently not set, then we can safetly set it to
-- this new calculated value.
-- However, if the alignment is known and too small it must be
-- increased, this happens in a case like:
-- type R is new Character;
-- for R'Size use 16;
-- Here the alignment inherited from Character is 1, but it must be
-- increased to 2 to reflect the increased size.
if Unknown_Alignment (E) or else Alignment (E) < A then
if Unknown_Alignment (E) then
Init_Alignment (E, A);
-- Cases where we have inherited an alignment
-- For constructed types, always reset the alignment, these are
-- Generally invisible to the user anyway, and that way we are
-- sure that no constructed types have weird alignments.
elsif not Comes_From_Source (E) then
Init_Alignment (E, A);
-- If this inherited alignment is the same as the one we computed,
-- then obviously everything is fine, and we do not need to reset it.
elsif Alignment (E) = A then
null;
-- Now we come to the difficult cases where we have inherited an
-- alignment and size, but overridden the size but not the alignment.
elsif Has_Size_Clause (E) or else Has_Object_Size_Clause (E) then
-- This is tricky, it might be thought that we should try to
-- inherit the alignment, since that's what the RM implies, but
-- that leads to complex rules and oddities. Consider for example:
-- type R is new Character;
-- for R'Size use 16;
-- It seems quite bogus in this case to inherit an alignment of 1
-- from the parent type Character. Furthermore, if that's what the
-- programmer really wanted for some odd reason, then they could
-- specify the alignment they wanted.
-- Furthermore we really don't want to inherit the alignment in
-- the case of a specified Object_Size for a subtype, since then
-- there would be no way of overriding to give a reasonable value
-- (we don't have an Object_Subtype attribute). Consider:
-- subtype R is new Character;
-- for R'Object_Size use 16;
-- If we inherit the alignment of 1, then we have an odd
-- inefficient alignment for the subtype, which cannot be fixed.
-- So we make the decision that if Size (or Object_Size) is given
-- (and, in the case of a first subtype, the alignment is not set
-- with a specific alignment clause). We reset the alignment to
-- the appropriate value for the specified size. This is a nice
-- simple rule to implement and document.
-- There is one slight glitch, which is that a confirming size
-- clause can now change the alignment, which, if we really think
-- that confirming rep clauses should have no effect, is a no-no.
-- type R is new Character;
-- for R'Alignment use 2;
-- type S is new R;
-- for S'Size use Character'Size;
-- Now the alignment of S is 1 instead of 2, as a result of
-- applying the above rule to the confirming rep clause for S. Not
-- clear this is worth worrying about. If we recorded whether a
-- size clause was confirming we could avoid this, but right now
-- we have no way of doing that or easily figuring it out, so we
-- don't bother.
-- Historical note. In versions of GNAT prior to Nov 6th, 2010, an
-- odd distinction was made between inherited alignments greater
-- than the computed alignment (where the larger alignment was
-- inherited) and inherited alignments smaller than the computed
-- alignment (where the smaller alignment was overridden). This
-- was a dubious fix to get around an ACATS problem which seems
-- to have disappeared anyway, and in any case, this peculiarity
-- was never documented.
Init_Alignment (E, A);
-- If no Size (or Object_Size) was specified, then we inherited the
-- object size, so we should inherit the alignment as well and not
-- modify it. This takes care of cases like:
-- type R is new Integer;
-- for R'Alignment use 1;
-- subtype S is R;
-- Here we have R has a default Object_Size of 32, and a specified
-- alignment of 1, and it seeems right for S to inherit both values.
else
null;
end if;
end;
end Set_Elem_Alignment;

5
gcc/ada/par-ch4.adb
View File

@ -2553,6 +2553,11 @@ package body Ch4 is
Node1 : Node_Id;
begin
if Ada_Version < Ada_2012 then
Error_Msg_SC ("quantified expression is an Ada 2012 feature");
Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
end if;
Scan; -- past FOR
Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);

14
gcc/ada/s-atocou-builtin.adb
View File

@ -50,7 +50,12 @@ package body System.Atomic_Counters is
function Decrement (Item : in out Atomic_Counter) return Boolean is
begin
return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0;
-- Note: the use of Unrestricted_Access here is required because we
-- are obtaining an access-to-volatile pointer to a non-volatile object.
-- This is not allowed for [Unchecked_]Access, but is safe in this case
-- because we know that no aliases are being created.
return Sync_Sub_And_Fetch (Item.Value'Unrestricted_Access, 1) = 0;
end Decrement;
---------------
@ -59,7 +64,12 @@ package body System.Atomic_Counters is
procedure Increment (Item : in out Atomic_Counter) is
begin
Sync_Add_And_Fetch (Item.Value'Access, 1);
-- Note: the use of Unrestricted_Access here is required because we
-- are obtaining an access-to-volatile pointer to a non-volatile object.
-- This is not allowed for [Unchecked_]Access, but is safe in this case
-- because we know that no aliases are being created.
Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1);
end Increment;
------------

6
gcc/ada/s-finmas.adb
View File

@ -181,6 +181,12 @@ package body System.Finalization_Masters is
if Master.Finalization_Started then
Unlock_Task.all;
-- Double finalization may occur during the handling of stand alone
-- libraries or the finalization of a pool with subpools. Due to the
-- potential aliasing of masters in these two cases, do not process
-- the same master twice.
return;
end if;

17
gcc/ada/s-taprop-linux.adb
View File

@ -990,11 +990,18 @@ package body System.Task_Primitives.Operations is
-- do not need to manipulate caller's signal mask at this point.
-- All tasks in RTS will have All_Tasks_Mask initially.
Result := pthread_create
(T.Common.LL.Thread'Access,
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));
-- Note: the use of Unrestricted_Access in the following call is needed
-- because otherwise we have an error of getting a access-to-volatile
-- value which points to a non-volatile object. But in this case it is
-- safe to do this, since we know we have no problems with aliasing and
-- Unrestricted_Access bypasses this check.
Result :=
pthread_create
(T.Common.LL.Thread'Unrestricted_Access,
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));
pragma Assert
(Result = 0 or else Result = EAGAIN or else Result = ENOMEM);

2
gcc/ada/s-taprop-vms.adb
View File

@ -811,7 +811,7 @@ package body System.Task_Primitives.Operations is
Result :=
pthread_create
(T.Common.LL.Thread'Access,
(T.Common.LL.Thread'Unrestricted_Access,
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));

22
gcc/ada/sem_ch3.adb
View File

@ -726,13 +726,33 @@ package body Sem_Ch3 is
-- If the access definition is the return type of another access to
-- function, scope is the current one, because it is the one of the
-- current type declaration.
-- current type declaration, except for the pathological case below.
if Nkind_In (Related_Nod, N_Object_Declaration,
N_Access_Function_Definition)
then
Anon_Scope := Current_Scope;
-- A pathological case: function returning access functions that
-- return access functions, etc. Each anonymous access type created
-- is in the enclosing scope of the outermost function.
declare
Par : Node_Id;
begin
Par := Related_Nod;
while Nkind_In (Par,
N_Access_Function_Definition,
N_Access_Definition)
loop
Par := Parent (Par);
end loop;
if Nkind (Par) = N_Function_Specification then
Anon_Scope := Scope (Defining_Entity (Par));
end if;
end;
-- For the anonymous function result case, retrieve the scope of the
-- function specification's associated entity rather than using the
-- current scope. The current scope will be the function itself if the

5
gcc/ada/sem_res.adb
View File

@ -11069,6 +11069,11 @@ package body Sem_Res is
N);
return True;
-- If it was legal in the generic, it's legal in the instance
elsif In_Instance_Body then
return True;
-- If both are tagged types, check legality of view conversions
elsif Is_Tagged_Type (Target_Type)

15
gcc/ada/sem_util.adb
View File

@ -8727,10 +8727,15 @@ package body Sem_Util is
then
return True;
elsif Nkind (N) = N_Indexed_Component
or else Nkind (N) = N_Selected_Component
elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component)
and then Is_Volatile_Prefix (Prefix (N))
then
return Is_Volatile_Prefix (Prefix (N));
return True;
elsif Nkind (N) = N_Selected_Component
and then Is_Volatile (Entity (Selector_Name (N)))
then
return True;
else
return False;
@ -10833,9 +10838,7 @@ package body Sem_Util is
-- source. This excludes, for example, calls to a dispatching
-- assignment operation when the left-hand side is tagged.
if Modification_Comes_From_Source
or else Alfa_Mode
then
if Modification_Comes_From_Source or else Alfa_Mode then
Generate_Reference (Ent, Exp, 'm');
-- If the target of the assignment is the bound variable

14
gcc/ada/sinput.ads
View File

@ -477,13 +477,13 @@ package Sinput is
-- In addition to the set of characters defined by the type in Types, in
-- wide character encoding, then the codes returning True for a call to
-- System.UTF_32.Is_UTF_32_Line_Terminator are also recognized as ending
-- a physical source line. This includes the standard codes defined above
-- in addition to NEL (NEXT LINE), LINE SEPARATOR and PARAGRAPH SEPARATOR.
-- Again, as in the case of VT and FF, the standard requires we recognize
-- these as line terminators, but we consider them to be logical line
-- terminators. The only physical line terminators recognized are the
-- standard ones (CR, LF, or CR/LF).
-- System.UTF_32.Is_UTF_32_Line_Terminator are also recognized as ending a
-- source line. This includes the standard codes defined above in addition
-- to NEL (NEXT LINE), LINE SEPARATOR and PARAGRAPH SEPARATOR. Again, as in
-- the case of VT and FF, the standard requires we recognize these as line
-- terminators, but we consider them to be logical line terminators. The
-- only physical line terminators recognized are the standard ones (CR,
-- LF, or CR/LF).
-- However, we do not recognize the NEL (16#85#) character as having the
-- significance of an end of line character when operating in normal 8-bit