This is the mail archive of the
gcc-bugs@gcc.gnu.org
mailing list for the GCC project.
[Bug ada/30698] New: in expand_one_stack_var_at, at cfgexpand.c:517
- From: "karlnick at student dot chalmers dot se" <gcc-bugzilla at gcc dot gnu dot org>
- To: gcc-bugs at gcc dot gnu dot org
- Date: 4 Feb 2007 10:42:53 -0000
- Subject: [Bug ada/30698] New: in expand_one_stack_var_at, at cfgexpand.c:517
- Reply-to: gcc-bugzilla at gcc dot gnu dot org
karlnick@db128:~/dns/src$ gnatmake dnsbrowse_gtk `gtkada2-config`
gcc-4.1 -c -I/usr/share/ada/adainclude/gtkada2 dnsbrowse_gtk.adb
gcc-4.1 -c -I/usr/share/ada/adainclude/gtkada2 communication.adb
+===========================GNAT BUG DETECTED==============================+
| 4.1.2 20061028 (prerelease) (Debian 4.1.1-19) (i486-pc-linux-gnu) GCC error:|
| in expand_one_stack_var_at, at cfgexpand.c:517 |
| Error detected at communication.adb:100:8 |
| Please submit a bug report; see http://gcc.gnu.org/bugs.html. |
| Use a subject line meaningful to you and us to track the bug. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc-4.1 or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| (concatenated together with no headers between files). |
+==========================================================================+
Please include these source files with error report
Note that list may not be accurate in some cases,
so please double check that the problem can still
be reproduced with the set of files listed.
communication.adb
communication.ads
dns.ads
dns-question.ads
communication.adb:17:07: warning: Storage_Error will be raised at run-time
compilation abandoned
gnatmake: "communication.adb" compilation error
karlnick@db128:~/dns/src$
with Ada.Unchecked_Conversion;
with Text_Io; use Text_Io;
with Dns.Question; use Dns.Question;
package body Communication is
package Integer_Io is new Text_Io.Integer_Io(Integer);
use Integer_Io;
procedure init is
begin
null;
end Init;
procedure Send_request is
Address : Sock_Addr_Type;
Channel : Stream_Access;
Port_Dns : Constant := 53;
Names : Name_Type;
Question : Question_Type;
begin
Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1);
Address.Port := Port_dns;
Names := Dns.Name("rho073.mtke.chalmers.se");
Create_Socket(Socket);
Connect_Socket(Socket, Address);
Put("Nameserver ");
Put_Line(Image(Address)); -- print the hosts ip-number:port-number
Channel := Stream(Socket);
Question := (Dns.Header_Type'(Id => 23,
Qr => Dns.Query,
Opcode => Dns.Query,
Aa => Dns.No,
Tc => Dns.No,
Rd => Dns.Yes,
Ra => Dns.No,
Z => Dns.No,
Rcode => Dns.No_Error,
others => 0),
Qname => Names,
Qtype => A,
Qclass => Internet);
Put_Line("Har sänt väntar på svar");
-- declare
-- Svar : Dns_Header_Type;
-- Adresses : Octet_Array_Ptr;
-- Tmp : Octet4_Array_Ptr;
-- Tmp2 : Label_Ptr;
-- begin
-- Dns.Io.Functions.Read(Channel, Svar);
-- Put("Har fått svar");New_Line;
-- Put("id:");Put(Integer(Svar.Id));New_Line;
-- if Svar.Question /= null then
-- Put("Questions:");Put(Svar.Question'Length);New_Line;
-- for N in Svar.Question'Range loop
-- Put(" names: ");
-- for I in Svar.Question(N).Qname'Range loop
-- Put(String(Svar.Question(N).Qname(I).all));Put(".");
-- end loop;
-- New_Line;
-- end loop;
-- end if;
-- if Svar.Answer /= null then
-- Put("answers:");Put(Svar.Answer'Length);New_Line;
-- for N in Svar.Answer'Range loop
-- Put(" names: ");
-- for I in Svar.Answer(N).Names'Range loop
-- Put(String(Svar.Answer(N).Names(I).all));Put(".");
-- end loop;
-- Put(" ");
-- Adresses :=
Svar.Answer(N).Rdata;Tmp:=Read_A(Svar.Answer(N));
-- for I in Adresses'Range loop
-- Put(Integer(Adresses(I)));Put(".");
-- end loop;
-- New_Line;
-- end loop;
-- end if;
-- if Svar.Authority /= null then
-- Put("Authorities:");Put(Svar.Authority'Length);New_Line;
-- for N in Svar.Authority'Range loop
-- Put(" Authority ");
-- for I in Svar.Authority(N).Names'Range loop
-- Put(String(Svar.Authority(N).Names(I).all));Put(".");
-- end loop;
-- Put(" ");
-- -- Tmp2:=Read_A(Svar.Authority(N));
-- -- for I in Tmp2'Range loop
-- -- Put(String(Tmp2(I).all));
-- -- end loop;
-- New_Line;
-- end loop;
-- end if;
-- if Svar.Additional /= null then
-- Put("Additionals:");Put(Svar.Additional'Length);New_Line;
-- end if;
-- end;
Close_Socket (Socket);
end Send_request;
procedure Quit is
begin
-- Put_Line("closing socket");
null;
end Quit;
end Communication;
with Gnat.Sockets; use Gnat.Sockets;
with Dns; use Dns;
package Communication is
Socket : Socket_Type;
procedure Init;
procedure Send_Request;
procedure quit;
end Communication;
with System; use System;
package Dns is
type Octet4 is range 0..2**32-1;
for Octet4'Size use 32;
type Octet2 is range 0..2**16-1;
for Octet2'Size use 16;
type Octet is range 0..2**8-1;
for Octet'Size use 8;
type Label_Type is private;
function Label(L : Label_Type) return String;
type Label_Array is array (Positive range <>) of Label_Type;
type Name_Type is private;
function Name(L : String) return Name_Type;
function Name(L : Name_Type) return Label_Array;
type Qr_Type is (Query, Response);
type Opcode_Type is (Query, Iquery, Status);
type Aa_Type is (No, Yes); -- Authoritative Answer
type Tc_Type is (No, Yes); -- TrunCation
type Rd_Type is (No, Yes); -- Recursion Desired
type Ra_Type is (No, Yes); -- Recursion Available
type Z_Type is (No); -- Reserved for future use. Must be zero in all
queries and responses.
type Rcode_Type Is (No_Error, Format_Error, Server_Failure, Name_Error,
Not_Implemented, Refused);
-- RFC 1035 Domain Implementation and Specification November 1987
-- 4. MESSAGES
-- 4.1. Format
-- All communications inside of the domain protocol are carried in a single
-- format called a message. The top level format of message is divided
-- into 5 sections (some of which are empty in certain cases) shown below:
-- +---------------------+
-- | Header |
-- +---------------------+
-- | Question | the question for the name server
-- +---------------------+
-- | Answer | RRs answering the question
-- +---------------------+
-- | Authority | RRs pointing toward an authority
-- +---------------------+
-- | Additional | RRs holding additional information
-- +---------------------+
type Header_Type is record
-- length : octet2; added by read and write (this i is not a part of the
header)
Id : Octet2; -- match responses to queries
Qr : Qr_Type; ---/-
Opcode : Opcode_Type; -- |
Aa : Aa_Type; -- |
Tc : Tc_Type; -- |
Rd : Rd_Type; -- | 2 octets
Ra : Ra_Type; -- |
Z : Z_Type; -- |
Rcode : Rcode_Type; ---/-
Qdcount : Octet2 := 0; -- query counter
Ancount : Octet2 := 0; -- answer counter
Nscount : Octet2 := 0; -- authority
Arcount : Octet2 := 0; -- additional
-- Question
-- Answer
-- Authority
-- Additional
end record;
for Header_Type use record
Id at 0 range 0..15;
Qr at 1*2 range 0..0; ---/-
Opcode at 1*2 range 1..4; -- |
Aa at 1*2 range 5..5; -- |
Tc at 1*2 range 6..6; -- | 2 octets network byte order
Rd at 1*2 range 7..7; -- |
Ra at 1*2 range 8..8; -- |
Z at 1*2 range 9..11; -- |
Rcode at 1*2 range 12..15; -- /-
Qdcount at 2*2 range 0..15;
Ancount at 3*2 range 0..15;
Nscount at 4*2 range 0..15;
Arcount at 5*2 range 0..15;
end record;
for Header_Type'Bit_Order use High_Order_First;
private
type Label_Type is array (Positive) of Octet;
type Name_Type is array (Positive) of Octet;
end Dns;
package Dns.Question is
-- RFC 1035 Domain Implementation and Specification November 1987
-- types and numbers Below from rfc1035.txt
-- TYPE value and meaning
type Qtype_Type is (Unknknown, -- padding begin with 0 (don't know how to
number from 1)
A, -- 1 a host address
NS, -- 2 an authoritative name server
MD, -- 3 a mail destination (Obsolete - use
MX)
MF, -- 4 a mail forwarder (Obsolete - use
MX)
CNAME, -- 5 the canonical name for an alias
SOA, -- 6 marks the start of a zone of
authority
MB, -- 7 a mailbox domain name
(EXPERIMENTAL)
MG, -- 8 a mail group member (EXPERIMENTAL)
MR, -- 9 a mail rename domain name
(EXPERIMENTAL)
Unknown2, -- 10 a null RR (EXPERIMENTAL)
WKS, -- 11 a well known service description
PTR, -- 12 a domain name pointer
HINFO, -- 13 host information
MINFO, -- 14 mailbox or mail list information
MX, -- 15 mail exchange
TXT -- 16 text strings
);
for Qtype_Type'size use Octet2'size;
-- RFC 1035 Domain Implementation and Specification November 1987
-- IN 1 the Internet
-- CS 2 the CSNET class (Obsolete - used only for examples in
some obsolete RFCs)
-- CH 3 the CHAOS class
-- HS 4 Hesiod [Dyer 87]
-- 3.2.5. QCLASS values
type Qclass_type is (Internet, CS, CH, HS); -- replaced IN with internet (in
reserved keyword)
for Qclass_type use (Internet => 1, CS => 2, CH => 3, HS => 4);
for Qclass_type'size use Octet2'size;
type Question_type is record
Header : Header_Type;
Qname : Name_Type;
Qtype : Qtype_Type; -- machine name or mail exchanger
Qclass : Qclass_Type;
end record;
end Dns.Question;
--
Summary: in expand_one_stack_var_at, at cfgexpand.c:517
Product: gcc
Version: 4.1.2
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: ada
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: karlnick at student dot chalmers dot se
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30698