Skip to content

R
riscv-gcc-1
Commit 6c802906 by Arnaud Charlet
Options

[multiple changes] 

2014-11-20  Pascal Obry  <obry@adacore.com>

	* initialize.c (ProcListCS): New extern variable (critical section).
	(ProcListEvt): New extern variable (handle).
	(__gnat_initialize)[Win32]: Initialize the ProcListCS critical
	section object and the ProcListEvt event.
	* final.c (__gnat_finalize)[Win32]: Properly finalize the
	ProcListCS critical section and the ProcListEvt event.
	* adaint.c (ProcListEvt): New Win32 event handle.
	(EnterCS): New routine to enter the critical section when dealing with
	child processes chain list.
	(LeaveCS): As above to exit from the critical section.
	(SignalListChanged): Routine to signal that the chain process list has
	been updated.
	(add_handle): Use EnterCS/LeaveCS, also call SignalListChanged when the
	handle has been added.
	(__gnat_win32_remove_handle): Use EnterCS/LeaveCS,
	also call SignalListChanged if the handle has been found and removed.
	(remove_handle): Routine removed, implementation merged with the above.
	(win32_wait): Use EnterCS/LeaveCS for the critical section. Properly
	copy the PID list locally to ensure that even if the list is updated
	the local copy remains valid. Add into the hl (handle list) the
	ProcListEvt handle. This handle is used to signal that a change has
	been made into the process chain list. This is to ensure that a waiting
	call can be resumed to take into account new processes. We also make
	sure that if the handle was not found into the list we start over
	the wait call. Indeed another concurrent call to win32_wait()
	could already have handled this process.

2014-11-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Actuals): The legality rule concerning
	the use of class-wide actuals for a non-controlling formal are
	not rechecked in an instance.

2014-11-20  Pascal Obry  <obry@adacore.com>

	* g-dirope.ads: Minor typo fix.

2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference,
	Expand_Update_Attribute): Preserve the tag of a prefix by offering
	a specific view of the class-wide version of the prefix.

From-SVN: r217837
parent 4b963531
Showing with 310 additions and 83 deletions
gcc/ada/ChangeLog
2014-11-20 Pascal Obry <obry@adacore.com>
* initialize.c (ProcListCS): New extern variable (critical section).
(ProcListEvt): New extern variable (handle).
(__gnat_initialize)[Win32]: Initialize the ProcListCS critical
section object and the ProcListEvt event.
* final.c (__gnat_finalize)[Win32]: Properly finalize the
ProcListCS critical section and the ProcListEvt event.
* adaint.c (ProcListEvt): New Win32 event handle.
(EnterCS): New routine to enter the critical section when dealing with
child processes chain list.
(LeaveCS): As above to exit from the critical section.
(SignalListChanged): Routine to signal that the chain process list has
been updated.
(add_handle): Use EnterCS/LeaveCS, also call SignalListChanged when the
handle has been added.
(__gnat_win32_remove_handle): Use EnterCS/LeaveCS,
also call SignalListChanged if the handle has been found and removed.
(remove_handle): Routine removed, implementation merged with the above.
(win32_wait): Use EnterCS/LeaveCS for the critical section. Properly
copy the PID list locally to ensure that even if the list is updated
the local copy remains valid. Add into the hl (handle list) the
ProcListEvt handle. This handle is used to signal that a change has
been made into the process chain list. This is to ensure that a waiting
call can be resumed to take into account new processes. We also make
sure that if the handle was not found into the list we start over
the wait call. Indeed another concurrent call to win32_wait()
could already have handled this process.
2014-11-20 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Actuals): The legality rule concerning
the use of class-wide actuals for a non-controlling formal are
not rechecked in an instance.
2014-11-20 Pascal Obry <obry@adacore.com>
* g-dirope.ads: Minor typo fix.
2014-11-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference,
Expand_Update_Attribute): Preserve the tag of a prefix by offering
a specific view of the class-wide version of the prefix.
2014-11-20 Javier Miranda <miranda@adacore.com> 2014-11-20 Javier Miranda <miranda@adacore.com>
* sem_ch6.adb (Analyze_Function_Return): For functions returning * sem_ch6.adb (Analyze_Function_Return): For functions returning
......
gcc/ada/adaint.c
...@@ -2311,20 +2311,29 @@ __gnat_number_of_cpus (void) ...@@ -2311,20 +2311,29 @@ __gnat_number_of_cpus (void)
for locking and unlocking tasks since we do not support multiple for locking and unlocking tasks since we do not support multiple
threads on this configuration (Cert run time on native Windows). */ threads on this configuration (Cert run time on native Windows). */
static void dummy (void) static void EnterCS (void) {}
{ static void LeaveCS (void) {}
} static void SignalListChanged (void) {}
void (*Lock_Task) () = &dummy;
void (*Unlock_Task) () = &dummy;
#else #else
#define Lock_Task system__soft_links__lock_task CRITICAL_SECTION ProcListCS;
extern void (*Lock_Task) (void); HANDLE ProcListEvt;
static void EnterCS (void)
{
EnterCriticalSection(&ProcListCS);
}
#define Unlock_Task system__soft_links__unlock_task static void LeaveCS (void)
extern void (*Unlock_Task) (void); {
LeaveCriticalSection(&ProcListCS);
}
static void SignalListChanged (void)
{
SetEvent (ProcListEvt);
}
#endif #endif
...@@ -2335,7 +2344,7 @@ static void ...@@ -2335,7 +2344,7 @@ static void
add_handle (HANDLE h, int pid) add_handle (HANDLE h, int pid)
{ {
/* -------------------- critical section -------------------- */ /* -------------------- critical section -------------------- */
(*Lock_Task) (); EnterCS();
if (plist_length == plist_max_length) if (plist_length == plist_max_length)
{ {
...@@ -2350,14 +2359,19 @@ add_handle (HANDLE h, int pid) ...@@ -2350,14 +2359,19 @@ add_handle (HANDLE h, int pid)
PID_LIST[plist_length] = pid; PID_LIST[plist_length] = pid;
++plist_length; ++plist_length;
(*Unlock_Task) (); SignalListChanged();
LeaveCS();
/* -------------------- critical section -------------------- */ /* -------------------- critical section -------------------- */
} }
static void int
remove_handle (HANDLE h, int pid) __gnat_win32_remove_handle (HANDLE h, int pid)
{ {
int j; int j;
int found = 0;
/* -------------------- critical section -------------------- */
EnterCS();
for (j = 0; j < plist_length; j++) for (j = 0; j < plist_length; j++)
{ {
...@@ -2367,21 +2381,18 @@ remove_handle (HANDLE h, int pid) ...@@ -2367,21 +2381,18 @@ remove_handle (HANDLE h, int pid)
--plist_length; --plist_length;
HANDLES_LIST[j] = HANDLES_LIST[plist_length]; HANDLES_LIST[j] = HANDLES_LIST[plist_length];
PID_LIST[j] = PID_LIST[plist_length]; PID_LIST[j] = PID_LIST[plist_length];
found = 1;
break; break;
} }
} }
}
void LeaveCS();
__gnat_win32_remove_handle (HANDLE h, int pid)
{
/* -------------------- critical section -------------------- */ /* -------------------- critical section -------------------- */
(*Lock_Task) ();
remove_handle(h, pid); if (found)
SignalListChanged();
(*Unlock_Task) (); return found;
/* -------------------- critical section -------------------- */
} }
static void static void
...@@ -2466,35 +2477,70 @@ win32_wait (int *status) ...@@ -2466,35 +2477,70 @@ win32_wait (int *status)
DWORD exitcode, pid; DWORD exitcode, pid;
HANDLE *hl; HANDLE *hl;
HANDLE h; HANDLE h;
int *pidl;
DWORD res; DWORD res;
int hl_len; int hl_len;
int found;
/* -------------------- critical section -------------------- */ START_WAIT:
(*Lock_Task) ();
if (plist_length == 0) if (plist_length == 0)
{ {
errno = ECHILD; errno = ECHILD;
(*Unlock_Task) ();
return -1; return -1;
} }
/* -------------------- critical section -------------------- */
EnterCS();
hl_len = plist_length; hl_len = plist_length;
#ifdef CERT
hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len); hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len); memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
pidl = (int *) xmalloc (sizeof (int) * hl_len);
memmove (pidl, PID_LIST, sizeof (int) * hl_len);
#else
/* Note that index 0 contains the event hanlde that is signaled when the
process list has changed */
hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len + 1);
hl[0] = ProcListEvt;
memmove (&hl[1], HANDLES_LIST, sizeof (HANDLE) * hl_len);
pidl = (int *) xmalloc (sizeof (int) * hl_len + 1);
memmove (&pidl[1], PID_LIST, sizeof (int) * hl_len);
hl_len++;
#endif
LeaveCS();
/* -------------------- critical section -------------------- */
res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE); res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
h = hl[res - WAIT_OBJECT_0];
/* if the ProcListEvt has been signaled then the list of processes has been
updated to add or remove a handle, just loop over */
if (res - WAIT_OBJECT_0 == 0)
{
free (hl);
free (pidl);
goto START_WAIT;
}
h = hl[res - WAIT_OBJECT_0];
GetExitCodeProcess (h, &exitcode); GetExitCodeProcess (h, &exitcode);
pid = PID_LIST [res - WAIT_OBJECT_0]; pid = pidl [res - WAIT_OBJECT_0];
remove_handle (h, -1);
found = __gnat_win32_remove_handle (h, -1);
(*Unlock_Task) ();
/* -------------------- critical section -------------------- */
free (hl); free (hl);
free (pidl);
/* if not found another process waiting has already handled this process */
if (!found)
{
goto START_WAIT;
}
*status = (int) exitcode; *status = (int) exitcode;
return (int) pid; return (int) pid;
......
gcc/ada/adaint.h
...@@ -299,7 +299,7 @@ extern void __gnat_cpu_set (int, size_t, cpu_set_t *); ...@@ -299,7 +299,7 @@ extern void __gnat_cpu_set (int, size_t, cpu_set_t *);
#if defined (_WIN32) #if defined (_WIN32)
/* Interface to delete a handle from internally maintained list of child /* Interface to delete a handle from internally maintained list of child
process handles on Windows */ process handles on Windows */
extern void extern int
__gnat_win32_remove_handle (HANDLE h, int pid); __gnat_win32_remove_handle (HANDLE h, int pid);
#endif #endif
......
gcc/ada/exp_attr.adb
...@@ -1021,6 +1021,9 @@ package body Exp_Attr is ...@@ -1021,6 +1021,9 @@ package body Exp_Attr is
Pref : constant Node_Id := Prefix (N); Pref : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Etype (Pref); Typ : constant Entity_Id := Etype (Pref);
Blk : Node_Id; Blk : Node_Id;
CW_Decl : Node_Id;
CW_Temp : Entity_Id;
CW_Typ : Entity_Id;
Decls : List_Id; Decls : List_Id;
Installed : Boolean; Installed : Boolean;
Loc : Source_Ptr; Loc : Source_Ptr;
...@@ -1338,18 +1341,55 @@ package body Exp_Attr is ...@@ -1338,18 +1341,55 @@ package body Exp_Attr is
-- Step 3: Create a constant to capture the value of the prefix at the -- Step 3: Create a constant to capture the value of the prefix at the
-- entry point into the loop. -- entry point into the loop.
-- Generate:
-- Temp : constant <type of Pref> := <Pref>;
Temp_Id := Make_Temporary (Loc, 'P'); Temp_Id := Make_Temporary (Loc, 'P');
Temp_Decl := -- Preserve the tag of the prefix by offering a specific view of the
Make_Object_Declaration (Loc, -- class-wide version of the prefix.
Defining_Identifier => Temp_Id,
Constant_Present => True, if Is_Tagged_Type (Typ) then
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Pref)); -- Generate:
Append_To (Decls, Temp_Decl); -- CW_Temp : constant Typ'Class := Typ'Class (Pref);
CW_Temp := Make_Temporary (Loc, 'T');
CW_Typ := Class_Wide_Type (Typ);
CW_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => CW_Temp,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (CW_Typ, Loc),
Expression =>
Convert_To (CW_Typ, Relocate_Node (Pref)));
Append_To (Decls, CW_Decl);
-- Generate:
-- Temp : Typ renames Typ (CW_Temp);
Temp_Decl :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Temp_Id,
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name =>
Convert_To (Typ, New_Occurrence_Of (CW_Temp, Loc)));
Append_To (Decls, Temp_Decl);
-- Non-tagged case
else
CW_Decl := Empty;
-- Generate:
-- Temp : constant Typ := Pref;
Temp_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp_Id,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Pref));
Append_To (Decls, Temp_Decl);
end if;
-- Step 4: Analyze all bits -- Step 4: Analyze all bits
...@@ -1374,6 +1414,10 @@ package body Exp_Attr is ...@@ -1374,6 +1414,10 @@ package body Exp_Attr is
-- the declaration of the constant. -- the declaration of the constant.
else else
if Present (CW_Decl) then
Analyze (CW_Decl);
end if;
Analyze (Temp_Decl); Analyze (Temp_Decl);
end if; end if;
...@@ -4358,19 +4402,13 @@ package body Exp_Attr is ...@@ -4358,19 +4402,13 @@ package body Exp_Attr is
--------- ---------
when Attribute_Old => Old : declare when Attribute_Old => Old : declare
Asn_Stm : Node_Id; Typ : constant Entity_Id := Etype (N);
CW_Temp : Entity_Id;
CW_Typ : Entity_Id;
Subp : Node_Id; Subp : Node_Id;
Temp : Entity_Id; Temp : Entity_Id;
begin begin
Temp := Make_Temporary (Loc, 'T', Pref);
-- Set the entity kind now in order to mark the temporary as a
-- handler of attribute 'Old's prefix.
Set_Ekind (Temp, E_Constant);
Set_Stores_Attribute_Old_Prefix (Temp);
-- Climb the parent chain looking for subprogram _Postconditions -- Climb the parent chain looking for subprogram _Postconditions
Subp := N; Subp := N;
...@@ -4395,15 +4433,13 @@ package body Exp_Attr is ...@@ -4395,15 +4433,13 @@ package body Exp_Attr is
pragma Assert (Present (Subp)); pragma Assert (Present (Subp));
-- Generate: Temp := Make_Temporary (Loc, 'T', Pref);
-- Temp : constant <Pref type> := <Pref>;
Asn_Stm := -- Set the entity kind now in order to mark the temporary as a
Make_Object_Declaration (Loc, -- handler of attribute 'Old's prefix.
Defining_Identifier => Temp,
Constant_Present => True, Set_Ekind (Temp, E_Constant);
Object_Definition => New_Occurrence_Of (Etype (N), Loc), Set_Stores_Attribute_Old_Prefix (Temp);
Expression => Pref);
-- Push the scope of the related subprogram where _Postcondition -- Push the scope of the related subprogram where _Postcondition
-- resides as this ensures that the object will be analyzed in the -- resides as this ensures that the object will be analyzed in the
...@@ -4411,12 +4447,49 @@ package body Exp_Attr is ...@@ -4411,12 +4447,49 @@ package body Exp_Attr is
Push_Scope (Scope (Defining_Entity (Subp))); Push_Scope (Scope (Defining_Entity (Subp)));
-- The object declaration is inserted before the body of subprogram -- Preserve the tag of the prefix by offering a specific view of the
-- _Postconditions. This ensures that any precondition-like actions -- class-wide version of the prefix.
-- are still executed before any parameter values are captured and
-- the multiple 'Old occurrences appear in order of declaration. if Is_Tagged_Type (Typ) then
-- Generate:
-- CW_Temp : constant Typ'Class := Typ'Class (Pref);
CW_Temp := Make_Temporary (Loc, 'T');
CW_Typ := Class_Wide_Type (Typ);
Insert_Before_And_Analyze (Subp,
Make_Object_Declaration (Loc,
Defining_Identifier => CW_Temp,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (CW_Typ, Loc),
Expression =>
Convert_To (CW_Typ, Relocate_Node (Pref))));
-- Generate:
-- Temp : Typ renames Typ (CW_Temp);
Insert_Before_And_Analyze (Subp,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Temp,
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name =>
Convert_To (Typ, New_Occurrence_Of (CW_Temp, Loc))));
-- Non-tagged case
else
-- Generate:
-- Temp : constant Typ := Pref;
Insert_Before_And_Analyze (Subp,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Pref)));
end if;
Insert_Before_And_Analyze (Subp, Asn_Stm);
Pop_Scope; Pop_Scope;
-- Ensure that the prefix of attribute 'Old is valid. The check must -- Ensure that the prefix of attribute 'Old is valid. The check must
...@@ -7351,30 +7424,65 @@ package body Exp_Attr is ...@@ -7351,30 +7424,65 @@ package body Exp_Attr is
-- Local variables -- Local variables
Aggr : constant Node_Id := First (Expressions (N)); Aggr : constant Node_Id := First (Expressions (N));
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Pref : constant Node_Id := Prefix (N); Pref : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Etype (Pref); Typ : constant Entity_Id := Etype (Pref);
Assoc : Node_Id; Assoc : Node_Id;
Comp : Node_Id; Comp : Node_Id;
Expr : Node_Id; CW_Temp : Entity_Id;
Temp : Entity_Id; CW_Typ : Entity_Id;
Expr : Node_Id;
Temp : Entity_Id;
-- Start of processing for Expand_Update_Attribute -- Start of processing for Expand_Update_Attribute
begin begin
-- Create the anonymous object that stores the value of the prefix and -- Create the anonymous object to store the value of the prefix and
-- reflects subsequent changes in value. Generate: -- capture subsequent changes in value.
Temp := Make_Temporary (Loc, 'T', Pref);
-- Temp : <type of Pref> := Pref; -- Preserve the tag of the prefix by offering a specific view of the
-- class-wide version of the prefix.
Temp := Make_Temporary (Loc, 'T'); if Is_Tagged_Type (Typ) then
Insert_Action (N, -- Generate:
Make_Object_Declaration (Loc, -- CW_Temp : Typ'Class := Typ'Class (Pref);
Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc), CW_Temp := Make_Temporary (Loc, 'T');
Expression => Relocate_Node (Pref))); CW_Typ := Class_Wide_Type (Typ);
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => CW_Temp,
Object_Definition => New_Occurrence_Of (CW_Typ, Loc),
Expression =>
Convert_To (CW_Typ, Relocate_Node (Pref))));
-- Generate:
-- Temp : Typ renames Typ (CW_Temp);
Insert_Action (N,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Temp,
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name =>
Convert_To (Typ, New_Occurrence_Of (CW_Temp, Loc))));
-- Non-tagged case
else
-- Generate:
-- Temp : Typ := Pref;
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Pref)));
end if;
-- Process the update aggregate -- Process the update aggregate
......
gcc/ada/final.c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2011, Free Software Foundation, Inc. * * Copyright (C) 1992-2014, 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- *
...@@ -40,10 +40,28 @@ extern void __gnat_finalize (void); ...@@ -40,10 +40,28 @@ extern void __gnat_finalize (void);
at all, the intention is that this be replaced by system specific code at all, the intention is that this be replaced by system specific code
where finalization is required. */ where finalization is required. */
#if defined (__MINGW32__)
#include "mingw32.h"
#include <windows.h>
extern CRITICAL_SECTION ProcListCS;
extern HANDLE ProcListEvt;
void
__gnat_finalize (void)
{
/* delete critical section and event handle used for the
processes chain list */
DeleteCriticalSection(&ProcListCS);
CloseHandle (ProcListEvt);
}
#else
void void
__gnat_finalize (void) __gnat_finalize (void)
{ {
} }
#endif
#ifdef __cplusplus #ifdef __cplusplus
} }
......
gcc/ada/g-dirope.ads
...@@ -175,7 +175,7 @@ package GNAT.Directory_Operations is ...@@ -175,7 +175,7 @@ package GNAT.Directory_Operations is
-- Returns Path with environment variables replaced by the current -- Returns Path with environment variables replaced by the current
-- environment variable value. For example, $HOME/mydir will be replaced -- environment variable value. For example, $HOME/mydir will be replaced
-- by /home/joe/mydir if $HOME environment variable is set to /home/joe and -- by /home/joe/mydir if $HOME environment variable is set to /home/joe and
-- Mode is UNIX. If an environment variable does not exists the variable -- Mode is UNIX. If an environment variable does not exist the variable
-- will be replaced by the empty string. Two dollar or percent signs are -- will be replaced by the empty string. Two dollar or percent signs are
-- replaced by a single dollar/percent sign. Note that a variable must -- replaced by a single dollar/percent sign. Note that a variable must
-- start with a letter. -- start with a letter.
......
gcc/ada/initialize.c
...@@ -74,6 +74,8 @@ extern void __gnat_install_SEH_handler (void *); ...@@ -74,6 +74,8 @@ extern void __gnat_install_SEH_handler (void *);
extern int gnat_argc; extern int gnat_argc;
extern char **gnat_argv; extern char **gnat_argv;
extern CRITICAL_SECTION ProcListCS;
extern HANDLE ProcListEvt;
#ifdef GNAT_UNICODE_SUPPORT #ifdef GNAT_UNICODE_SUPPORT
...@@ -138,6 +140,11 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED) ...@@ -138,6 +140,11 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
given that we have set Max_Digits etc with this in mind */ given that we have set Max_Digits etc with this in mind */
__gnat_init_float (); __gnat_init_float ();
/* Initialize the critical section and event handle for the win32_wait()
implementation, see adaint.c */
InitializeCriticalSection (&ProcListCS);
ProcListEvt = CreateEvent (NULL, FALSE, FALSE, NULL);
#ifdef GNAT_UNICODE_SUPPORT #ifdef GNAT_UNICODE_SUPPORT
/* Set current code page for filenames handling. */ /* Set current code page for filenames handling. */
{ {
......
gcc/ada/sem_res.adb
...@@ -4520,9 +4520,12 @@ package body Sem_Res is ...@@ -4520,9 +4520,12 @@ package body Sem_Res is
Validate_Remote_Access_To_Class_Wide_Type (A); Validate_Remote_Access_To_Class_Wide_Type (A);
end if; end if;
-- Apply legality rule 3.9.2 (9/1)
if (Is_Class_Wide_Type (A_Typ) or else Is_Dynamically_Tagged (A)) if (Is_Class_Wide_Type (A_Typ) or else Is_Dynamically_Tagged (A))
and then not Is_Class_Wide_Type (F_Typ) and then not Is_Class_Wide_Type (F_Typ)
and then not Is_Controlling_Formal (F) and then not Is_Controlling_Formal (F)
and then not In_Instance
then then
Error_Msg_N ("class-wide argument not allowed here!", A); Error_Msg_N ("class-wide argument not allowed here!", A);
......
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