void PREFIX(gerror) (char * msg, gfc_charlen_type msg_len) { int p_len; char *p; p = gf_strerror (errno, msg, msg_len); p_len = strlen (p); /* The returned pointer p might or might not be the same as the msg argument. */ if (p != msg) { if (msg_len < p_len) p_len = msg_len; memcpy (msg, p, p_len); } if (msg_len > p_len) memset (&msg[p_len], ' ', msg_len - p_len); }
gfc_unit * new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) { gfc_unit *u2; stream *s; char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */]; /* Change unspecifieds to defaults. Leave (flags->action == ACTION_UNSPECIFIED) alone so open_external() can set it based on what type of open actually works. */ if (flags->access == ACCESS_UNSPECIFIED) flags->access = ACCESS_SEQUENTIAL; if (flags->form == FORM_UNSPECIFIED) flags->form = (flags->access == ACCESS_SEQUENTIAL) ? FORM_FORMATTED : FORM_UNFORMATTED; if (flags->async == ASYNC_UNSPECIFIED) flags->async = ASYNC_NO; if (flags->status == STATUS_UNSPECIFIED) flags->status = STATUS_UNKNOWN; if (flags->cc == CC_UNSPECIFIED) flags->cc = flags->form == FORM_UNFORMATTED ? CC_NONE : CC_LIST; else if (flags->form == FORM_UNFORMATTED && flags->cc != CC_NONE) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } /* Checks. */ if (flags->delim != DELIM_UNSPECIFIED && flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } if (flags->blank == BLANK_UNSPECIFIED) flags->blank = BLANK_NULL; else { if (flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } } if (flags->pad == PAD_UNSPECIFIED) flags->pad = PAD_YES; else { if (flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "PAD parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } } if (flags->decimal == DECIMAL_UNSPECIFIED) flags->decimal = DECIMAL_POINT; else { if (flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "DECIMAL parameter conflicts with UNFORMATTED form " "in OPEN statement"); goto fail; } } if (flags->encoding == ENCODING_UNSPECIFIED) flags->encoding = ENCODING_DEFAULT; else { if (flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "ENCODING parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } } /* NB: the value for ROUND when it's not specified by the user does not have to be PROCESSOR_DEFINED; the standard says that it is processor dependent, and requires that it is one of the possible value (see F2003, 9.4.5.13). */ if (flags->round == ROUND_UNSPECIFIED) flags->round = ROUND_PROCDEFINED; else { if (flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "ROUND parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } } if (flags->sign == SIGN_UNSPECIFIED) flags->sign = SIGN_PROCDEFINED; else { if (flags->form == FORM_UNFORMATTED) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "SIGN parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; } } if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) { generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "ACCESS parameter conflicts with SEQUENTIAL access in " "OPEN statement"); goto fail; } else if (flags->position == POSITION_UNSPECIFIED) flags->position = POSITION_ASIS; if (flags->access == ACCESS_DIRECT && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) { generate_error (&opp->common, LIBERROR_MISSING_OPTION, "Missing RECL parameter in OPEN statement"); goto fail; } if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0) { generate_error (&opp->common, LIBERROR_BAD_OPTION, "RECL parameter is non-positive in OPEN statement"); goto fail; } switch (flags->status) { case STATUS_SCRATCH: if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) { opp->file = NULL; break; } generate_error (&opp->common, LIBERROR_BAD_OPTION, "FILE parameter must not be present in OPEN statement"); goto fail; case STATUS_OLD: case STATUS_NEW: case STATUS_REPLACE: case STATUS_UNKNOWN: if ((opp->common.flags & IOPARM_OPEN_HAS_FILE)) break; opp->file = tmpname; opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d", (int) opp->common.unit); break; default: internal_error (&opp->common, "new_unit(): Bad status"); } /* Make sure the file isn't already open someplace else. Do not error if opening file preconnected to stdin, stdout, stderr. */ u2 = NULL; if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0) u2 = find_file (opp->file, opp->file_len); if (u2 != NULL && (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit) && (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit) && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit)) { unlock_unit (u2); generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL); goto cleanup; } if (u2 != NULL) unlock_unit (u2); /* Open file. */ s = open_external (opp, flags); if (s == NULL) { char errbuf[256]; char *path = fc_strdup (opp->file, opp->file_len); size_t msglen = opp->file_len + 22 + sizeof (errbuf); char *msg = xmalloc (msglen); snprintf (msg, msglen, "Cannot open file '%s': %s", path, gf_strerror (errno, errbuf, sizeof (errbuf))); generate_error (&opp->common, LIBERROR_OS, msg); free (msg); free (path); goto cleanup; } if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE) flags->status = STATUS_OLD; /* Create the unit structure. */ if (u->unit_number != opp->common.unit) internal_error (&opp->common, "Unit number changed"); u->s = s; u->flags = *flags; u->read_bad = 0; u->endfile = NO_ENDFILE; u->last_record = 0; u->current_record = 0; u->mode = READING; u->maxrec = 0; u->bytes_left = 0; u->saved_pos = 0; if (flags->position == POSITION_APPEND) { if (sseek (u->s, 0, SEEK_END) < 0) { generate_error (&opp->common, LIBERROR_OS, NULL); goto cleanup; } u->endfile = AT_ENDFILE; } /* Unspecified recl ends up with a processor dependent value. */ if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) { u->flags.has_recl = 1; u->recl = opp->recl_in; u->recl_subrecord = u->recl; u->bytes_left = u->recl; } else { u->flags.has_recl = 0; u->recl = max_offset; if (compile_options.max_subrecord_length) { u->recl_subrecord = compile_options.max_subrecord_length; } else { switch (compile_options.record_marker) { case 0: /* Fall through */ case sizeof (GFC_INTEGER_4): u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH; break; case sizeof (GFC_INTEGER_8): u->recl_subrecord = max_offset - 16; break; default: runtime_error ("Illegal value for record marker"); break; } } } /* If the file is direct access, calculate the maximum record number via a division now instead of letting the multiplication overflow later. */ if (flags->access == ACCESS_DIRECT) u->maxrec = max_offset / u->recl; if (flags->access == ACCESS_STREAM) { u->maxrec = max_offset; u->recl = 1; u->bytes_left = 1; u->strm_pos = stell (u->s) + 1; } u->filename = fc_strdup (opp->file, opp->file_len); /* Curiously, the standard requires that the position specifier be ignored for new files so a newly connected file starts out at the initial point. We still need to figure out if the file is at the end or not. */ test_endfile (u); if (flags->status == STATUS_SCRATCH && opp->file != NULL) free (opp->file); if (flags->form == FORM_FORMATTED) { if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) fbuf_init (u, u->recl); else fbuf_init (u, 0); } else u->fbuf = NULL; return u; cleanup: /* Free memory associated with a temporary filename. */ if (flags->status == STATUS_SCRATCH && opp->file != NULL) free (opp->file); fail: close_unit (u); return NULL; }